SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00051 MATH ROUTINES 1 05-28-9313:50ALL SWAG SUPPORT TEAM 3DPOINTS.PAS IMPORT 7 {π> Could someone please explain how to plot a 3-D points? How do you convertπ> a 3D XYZ value, to an XY value that can be plotted onto the screen?π}ππFunction x3d(x1, z1 : Integer) : Integer;πbeginπ x3d := Round(x1 - (z1 * Cos(Theta)));πend;ππFunction y3d(y1, z1 : Integer) : Integer;πbeginπ y3d := Round(y1 - (z1 * Sin(Theta)));πend;ππ{πSo a Function that plots a 3d pixel might look like this:ππProcedure plot3d(x, y, z : Integer);πbeginπ plot(x3d(x, z), y3d(y, z));πend;ππThe theta above is the angle on the screen on which your are "simulating"πyour z axis. This is simplistic, but should get you started. Just rememberπyou are simulating 3 dimensions on a 2 dimension media (the screen). Trigπhelps. ;-)π} 2 05-28-9313:50ALL SWAG SUPPORT TEAM CIRCLE3P.PAS IMPORT 28 Program ThreePoints_TwoPoints;π{ππ I Really appreciate ya helping me With this 3 points on aπcircle problem. The only thing is that I still can't get itπto work. I've tried the Program you gave me and it spits outπthe wrong answers. I don't know if there are parentheses in theπwrong place or what. Maybe you can find the error.π π You'll see that I've inserted True coordinates For this test.π πThank you once again...and please, when you get any more informationπon this problem...call me collect person to person or leave it on myπBBS. I get the turbo pascal echo from a California BBS and that sureπis long distance. Getting a good pascal Procedure For this isπimportant to me because I am using it in a soon to be released mathπProgram called Mr. Machinist! I've been racking my brain about thisπfor 2 weeks now and I've even been dream'in about it!π πYour help is appreciated!!!π π +π+AL+π π(716) 434-7823 Voiceπ(716) 434-1448 BBS ... if none of these, then leave Program on TP echo.π π}π πUsesπ Crt;πConstπ x1 = 4.0642982;π y1 = 0.9080732;π x2 = 1.6679862;π y2 = 2.8485684;π x3 = 4.0996421;π y3 = 0.4589868;ππVarπ Selection : Integer;πProcedure ThreePoints;πVarπ Slope1,π Slope2,π Mid1x,π Mid1y,π Mid2x,π Mid2y,π Cx,π Cy,π Radius : Real;πbeginπ ClrScr;π Writeln('3 points on a circle');π Writeln('====================');π Writeln;π Writeln('X1 -> 4.0642982');π Writeln('Y1 -> 0.9080732');π Writeln;π Writeln('X2 -> 1.6679862');π Writeln('Y2 -> 2.8485684');π Writeln('X3 -> 4.0996421');π Writeln('Y3 -> 0.4589868');π Writeln;π Slope1 := (y2 - y1) / (x2 - x1);π Slope2 := (y3 - y2) / (x3 - x2);π Mid1x := (x1 + x2) / 2;π Mid1y := (y1 + y2) / 2;π Mid2x := (x2 + x3) / 2;π Mid2y := (y2 + y3) / 2;π Slope1 := -1 * (1 / Slope1);π Slope2 := -1 * (1 / Slope2);π Cx := (Slope2 * x2 - y2 - Slope1 * x1 + y1) / (Slope1 - Slope2);π Cy := Slope1 * (Cx + x1) - y1;ππ {π I believe you missed out on using Cx and Cy in next line,π Radius := sqrt(((x1 - x2) * (x1 - x2)) + ((y1 - y2) * (y1 - y2)));π I think it should be . . .π }ππ Radius := Sqrt(Sqr((x1 - Cx) + (y1 - Cy)));π Writeln;π Writeln('X center line (Program answer) is ', Cx : 4 : 4);π Writeln('Y center line (Program answer) is ', Cy : 4 : 4);π Writeln('The radius (Program answer) is ', Radius : 4 : 4);π Writeln;π Writeln('True X center = 1.7500');π Writeln('True Y center = 0.5000');π Writeln('True Radius = 2.3500');π Writeln('Strike any key to continue . . .');π ReadKey;πend;ππProcedure Distance2Points;πVarπ x1, y1,π x2, y2,π Distance : Real;πbeginπ ClrScr;π Writeln('Distance between 2 points');π Writeln('=========================');π Writeln;π Write('X1 -> ');π Readln(x1);π Write('Y1 -> ');π Readln(y1);π Writeln;π Write('X2 -> ');π Readln(x2);π Write('Y2 -> ');π Readln(y2);π Writeln;π Writeln;π Distance := Sqrt((Sqr(x2 - x1)) + (Sqr(y2 - y1)));π Writeln('Distance between point 1 and point 2 = ', Distance : 4 : 4);π Writeln;π Writeln('Strike any key to continue . . .');ππ ReadKey;πend;ππbeginπ ClrScr;π Writeln;π Writeln;π Writeln('1) Distance between 2 points');π Writeln('2) 3 points on a circle test Program');π Writeln('0) Quit');π Writeln;π Write('Choose a menu number: ');π Readln(Selection);π Case Selection ofπ 1 : Distance2Points;π 2 : ThreePoints;π end;π ClrScr;πend.π 3 05-28-9313:50ALL SWAG SUPPORT TEAM EQUATE.PAS IMPORT 29 { Author: Gavin Peters. }ππProgram PostFixConvert;π(*π * This Program will convert a user entered expression to postfix, andπ * evaluate it simultaniously. Written by Gavin Peters, based slightlyπ * on a stack example given in Algorithms (Pascal edition), pgπ *π *)πVarπ Stack : Array[1 .. 3] of Array[0 .. 500] of LongInt;ππProcedure Push(which : Integer; p : LongInt);πbeginπ Stack[which,0] := Stack[which,0]+1;π Stack[which,Stack[which,0]] := pπend;ππFunction Pop(which : Integer) : LongInt;πbeginπ Pop := Stack[which,Stack[which,0]];π Stack[which,0] := Stack[which,0]-1πend;ππVarπ c : Char;π x,t,π bedmas : LongInt;π numbers : Boolean;ππProcedure Evaluate( ch : Char );ππ Function Power( exponent, base : LongInt ) : LongInt;π beginπ if Exponent > 0 thenπ Power := Base*Power(exponent-1, base)π ELSEπ Power := 1π end;ππbeginπ Write(ch);π if Numbers and not (ch = ' ') thenπ x := x * 10 + (Ord(c) - Ord('0'))π ELSEπ beginπ Case ch OFπ '*' : x := pop(2)*pop(2);π '+' : x := pop(2)+pop(2);π '-' : x := pop(2)-pop(2);π '/' : x := pop(2) div pop(2);π '%' : x := pop(2) MOD pop(2);π '^' : x := Power(pop(2),pop(2));π 'L' : x := pop(2) SHL pop(2);π 'R' : x := pop(2) SHR pop(2);π '|' : x := pop(2) or pop(2);π '&' : x := pop(2) and pop(2);π '$' : x := pop(2) xor pop(2);π '=' : if pop(2) = pop(2) thenπ x := 1π elseπ x := 0;π '>' : if pop(2) > pop(2) thenπ x := 1π elseπ x := 0;π '<' : if pop(2) < pop(2) thenπ x := 1π elseπ x := 0;π '0','1'..'9' :π beginπ Numbers := True;π x := Ord(c) - Ord('0');π Exitπ end;π ' ' : if not Numbers thenπ Exit;π end;ππ Numbers := False;π Push(2,x);π end;πend;ππbeginπ Writeln('Gavin''s calculator, version 1.00');π Writeln;π For x := 1 to 3 DOπ Stack[x, 0] := 0;π x := 0;π numbers := False;π Bedmas := 50;π Writeln('Enter an expression in infix:');π Repeatπ Read(c);π Case c OFπ ')' :π beginπ Bedmas := Pop(3);π Evaluate(' ');π Evaluate(Chr(pop(1)));π end;ππ '^','%','+','-','*','/','L','R','|','&','$','=','<','>' :π beginπ t := bedmas;π Case c Ofππ '>','<' : bedmas := 3;π '|','$',π '+','-' : bedmas := 2;π '%','L','R','&',π '*','/' : bedmas := 1;π '^' : bedmas := 0;π end;π if t <= bedmas thenπ beginπ Evaluate(' ');π Evaluate(Chr(pop(1)));π end;π Push(1,ord(c));π Evaluate(' ');π end;π '(' :π beginπ Push(3,bedmas);π bedmas := 50;π end;π '0','1'..'9' : Evaluate(c);π end;ππ Until Eoln;ππ While Stack[1,0] <> 0 DOπ beginπ Evaluate(' ');π Evaluate(Chr(pop(1)));π end;π Evaluate(' ');π Writeln;π Writeln;π Writeln('The result is ',Pop(2));πend.ππ{πThat's it, all. This is an evaluator, like Reuben's, With a fewπmore features, and it's shorter.ππOkay, there it is (the above comment was in the original post). I'veπnever tried it, but it looks good. :-) BTW, if it does work you mightπwant to thank Gavin Peters... after all, he wrote it. I was justπinterested when I saw it, and stored it along With a bunch of otherπsource-code tidbits I've git here...π}π 4 05-28-9313:50ALL SWAG SUPPORT TEAM FIBONACC.PAS IMPORT 5 {π>The problem is to Write a recursive Program to calculate Fibonacci numbers.π>The rules For the Fibonacci numbers are:π>π> The Nth Fib number is:π>π> 1 if N = 1 or 2π> The sum of the previous two numbers in the series if N > 2π> N must always be > 0.π}ππFunction fib(n : LongInt) : LongInt;πbeginπ if n < 2 thenπ fib := nπ elseπ fib := fib(n - 1) + fib(n - 2);πend;ππVarπ Count : Integer;ππbeginπ Writeln('Fib: ');π For Count := 1 to 15 doπ Write(Fib(Count),', ');πend. 5 05-28-9313:50ALL SWAG SUPPORT TEAM GAUSS.PAS IMPORT 121 Program Gauss_Elimination;ππUses Crt,Printer;ππ(***************************************************************************)π(* STEPHEN ABRAHAM *)π(* MCEN 3030 Comp METHODS *)π(* ASSGN #3 *)π(* DUE: 2-12-93 *)π(* *)π(* GAUSS ELIMinATION (TURBO PASCAL VERSION by STEPHEN ABRAHAM) *)π(* *)π(***************************************************************************)π{ }π{ }π{------------------VarIABLE DECLARATION and DEFinITIONS--------------------}ππConstπ MAXROW = 50; (* Maximum # of rows in a matrix *)π MAXCOL = 50; (* Maximum # of columns in a matrix *)ππTypeπ Mat_Array = Array[1..MAXROW,1..MAXCOL] of Real; (* 2-D Matrix of Reals *)π Col_Array = Array[1..MAXCOL] of Real; (* 1-D Matrix of Real numbers *)π Int_Array = Array[1..MAXCOL] of Integer; (* 1-D Matrix of Integers *)ππVarπ N_EQNS : Integer; (* User Input : Number of equations in system *)π COEFF_MAT : Mat_Array; (* User Input : Coefficient Matrix of system *)π COL_MAT : Col_Array; (* User Input : Column matrix of Constants *)π X_MAT : Col_Array; (* OutPut : Solution matrix For unknowns *)π orDER_VECT : Int_Array; (* Defined to pivot rows where necessary *)π SCALE_VECT : Col_Array; (* Defined to divide by largest element in *)π (* row For normalizing effect *)π I,J,K : Integer; (* Loop control and Array subscripts *)π Ans : Char; (* Yes/No response to check inputted matrix *)πππ{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}ππππ{^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^}π{>>>>>>>>>>>>>>>>>>>>>>>>> ProcedureS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<}π{...........................................................................}πππProcedure Home; (* clears screen and positions cursor at (1,1) *)πbeginπ ClrScr;π GotoXY(1,1);πend; (* Procedure Home *)ππ{---------------------------------------------------------------------------}πππProcedure Instruct; (* provides user instructions if wanted *)ππVarπ Ans : Char; (* Yes/No answer by user For instructions or not *)ππbeginπ Home; (* calls Home Procedure *)π GotoXY(22,8); Writeln('STEVE`S GAUSSIAN ELIMinATION Program');π GotoXY(36,10); Writeln('2-12-92');π GotoXY(31,18); Write('Instructions(Y/N):');π GotoXY(31,49); readln(Ans);π if Ans in ['Y','y'] thenπ beginπ Home; (* calls Home Procedure *)π Writeln(' Welcome to Steve`s Gaussian elimination Program. With this');π Writeln('Program you will be able to enter the augmented matrix of ');π Writeln('your system of liNear equations and have returned to you the ');π Writeln('solutions For each unknown. The Computer will ask you to ');π Writeln('input the number of equations in your system and will then ');π Writeln('have you input your coefficient matrix and then your column ');π Writeln('matrix. Please remember For n unknowns, you will need to ');π Writeln('have n equations. ThereFore you should be entering a square ');π Writeln('(nxn) coefficient matrix. Have FUN!!!! ');π Writeln('(hit <enter> to continue...)'); (* Delay *)π readln;π end;πend;πππ{---------------------------------------------------------------------------}πππProcedure Initialize_Array( Var Coeff_Mat : Mat_Array ;π Var Col_Mat,X_Mat, Scale_Vect : Col_Array;π Var order_Vect : Int_Array);ππ(*** This Procedure initializes all matrices to be used in Program ***)π(*** ON ENTRY : Matrices have undefined values in them ***)π(*** ON Exit : All Matrices are zero matrices ***)πππConstπ MAXROW = 50; { maximum # of rows in matrix }π MAXCOL = 50; { maximum # of columns in matrix }ππVarπ I : Integer; { I & J are both loop control and Array subscripts }π J : Integer;ππbeginπ For I := 1 to MaxRow do { row indices }π beginπ Col_Mat[I] := 0;π X_Mat[I] := 0;π order_Vect[I] := 0;π Scale_Vect[I] := 0;π For J := 1 to MaxCol do { column indices }π Coeff_Mat[I,J] := 0;π end;πend; (* Procedure initialize_Array *)πππ{---------------------------------------------------------------------------}ππProcedure Input(Var N : Integer;π Var Coeff_Mat1 : Mat_Array;π Var Col_Mat1 : Col_Array);ππ(*** This Procedure lets the user input the number of equations and the ***)π(*** augmented matrix of their system of equations ***)π(*** ON ENTRY : N => number of equations : UNDEFinEDπ Coeff_Mat1 => coefficient matrix : UNDEFinEDπ Col_Mat1 => column matrix :UNDEFinEDπ ON Exit : N => # of equations input by userπ Coeff_Mat1 => defined coefficient matrixπ Col_Mat1 => defined column matrix input by user ***)ππππVarπ I,J : Integer; (* loop control and Array indices *)ππbeginπ Home; (* calls Procedure Home *)π Write('Enter the number of equations in your system: ');π readln(N);π Writeln;π Writeln('Now you will enter your coefficient and column matrix:');π For I := 1 to N do { row indice }π beginπ Writeln('ROW #',I);π For J := 1 to N do {column indice }π beginπ Write('a(',I,',',J,'):');π readln(Coeff_Mat1[I,J]); {input of coefficient matrix}π end;π Write('c(',I,'):');π readln(Col_Mat1[I]); {input of Constant matrix}π end;π readln;πend; (* Procedure Input *)πππ{---------------------------------------------------------------------------}πππProcedure Check_Input( Coeff_Mat1 : Mat_Array;π N : Integer; Var Ans : Char);ππ(*** This Procedure displays the user's input matrix and asks if it is ***)π(*** correct. ***)π(*** ON ENTRY : Coeff_Mat1 => inputted matrixπ N => inputted number of equationsπ Ans => UNDEFinED ***)π(*** ON Exit : Coeff_Mat1 => n/aπ N => n/aπ Ans => Y,y or N,n ***)πππVarπ I,J : Integer; (* loop control and Array indices *)ππbeginπ Home; (* calls Home Procedure *)π Writeln; Writeln('Your inputted augmented matrix is:');Writeln;Writeln;ππ For I := 1 to N do { row indice }π beginπ For J := 1 to N do { column indice }π Write(Coeff_Mat[I,J]:12:4);π Writeln(Col_Mat[I]:12:4);π end;π Writeln; Write('Is this your desired matrix?(Y/N):'); (* Gets Answer *)π readln(Ans);πend; (* Procedure Check_Input *)πππ{---------------------------------------------------------------------------}πππProcedure order(Var Scale_Vect1 : Col_Array;π Var order_Vect1 : Int_Array;π Var Coeff_Mat1 : Mat_Array;π N : Integer);ππ(*** This Procedure finds the order and scaling value For each row of theπ inputted coefficient matrix. ***)π(*** ON ENTRY : Scale_Vect1 => UNDEFinEDπ order_Vect1 => UNDEFinEDπ Coeff_Mat1 => as inputtedπ N => # of equationsπ ON Exit : Scale_Vect1 => contains highest value For each row of theπ coefficient matrixπ order_Vect1 => is assigned the row number of each row fromπ the coefficient matrix in orderπ Coeff_Mat => n/aπ N => n/a ***)πππVarπ I,J : Integer; {loop control and Array indices}ππbeginπFor I := 1 to N doπ beginπ order_Vect1[I] := I; (* ordervect gets the row number of each row *)π Scale_Vect1[I] := Abs(Coeff_Mat1[I,1]); (* gets the first number of each row *)π For J := 2 to N do { goes through the columns }π begin (* Compares values in each row of the coefficient matrix andπ stores this value in scale_vect[i] *)π if Abs(Coeff_Mat1[I,J]) > Scale_Vect1[I] thenπ Scale_Vect1[I] := Abs(Coeff_Mat1[I,J]);π end;π end;πend; (* Procedure order *)πππ{---------------------------------------------------------------------------}πππProcedure Pivot(Var Scale_Vect1 : Col_Array;π Coeff_Mat1 : Mat_Array;π Var order_Vect1 : Int_Array;π K,N : Integer);ππ(*** This Procedure finds the largest number in each column after it has beenπ scaled and Compares it With the number in the corresponding diagonalπ position. For example, in column one, a(1,1) is divided by the scalingπ factor of row one. then each value in the matrix that is in column oneπ is divided by its own row's scaling vector and Compared With theπ position above it. So a(1,1)/scalevect[1] is Compared to a[2,1]/scalevect[2]π and which ever is greater has its row number stored as pivot. Once theπ highest value For a column is found, rows will be switched so that theπ leading position has the highest possible value after being scaled. ***)ππ(*** ON ENTRY : Scale_Vect1 => the normalizing value of each rowπ Coeff_Mat1 => the inputted coefficient matrixπ order_Vect1 => the row number of each row in original orderπ K => passed in from the eliminate Procedureπ N => number of equationsπ ON Exit : Scale_Vect => sameπ Coeff_Mat1 => sameπ order_Vect => contains the row number With highest scaledπ valueπ k => n/aπ N => n/a ***)ππVarπ I : Integer; {loop control and Array indice }π Pivot, Idum : Integer; {holds temporary values For pivoting }π Big,Dummy : Real; {used to Compare values of each column }πbeginπ Pivot := K;π Big := Abs(Coeff_Mat1[order_Vect1[K],K]/Scale_Vect1[order_Vect1[K]]);π For I := K+1 to N doπ beginπ Dummy := Abs(Coeff_Mat1[order_Vect1[I],K]/Scale_Vect1[order_Vect1[I]]);π if Dummy > Big thenπ beginπ Big := Dummy;π Pivot := I;π end;π end;π Idum := order_Vect1[Pivot]; { switching routine }π order_Vect1[Pivot] := order_Vect1[K];π order_Vect1[K] := Idum;πend; { Procedure pivot }πππ{---------------------------------------------------------------------------}ππProcedure Eliminate(Var Col_Mat1, Scale_Vect1 : Col_Array;π Var Coeff_Mat1 : Mat_Array;π Var order_Vect1 : Int_Array;π N : Integer);πππVarπ I,J,K : Integer;π Factor : Real;ππbeginπ For K := 1 to N-1 doπ beginπ Pivot (Scale_Vect1,Coeff_Mat1,order_Vect1,K,N);π For I := K+1 to N doπ beginπ Factor := Coeff_Mat1[order_Vect1[I],K]/Coeff_Mat1[order_Vect1[K],K];π For J := K+1 to N doπ beginπ Coeff_Mat1[order_Vect1[I],J] := Coeff_Mat1[order_Vect1[I],J] -π Factor*Coeff_Mat1[order_Vect1[K],J];π end;π Col_Mat1[order_Vect1[I]] := Col_Mat1[order_Vect1[I]] - Factor*Col_Mat1[order_Vect1[K]];π end;π end;πend;πππ{---------------------------------------------------------------------------}πππProcedure Substitute(Var Col_Mat1, X_Mat1 : Col_Array;π Coeff_Mat1 : Mat_Array;π Var order_Vect1 : Int_Array;π N : Integer);ππ(*** This Procedure will backsubstitute to find the solutions to yourπ system of liNear equations.π ON ENTRY : Col_Mat => your modified Constant column matrixπ X_Mat1 => UNDEFinEDπ Coeff_Mat1 => modified into upper triangular matrixπ order_Vect => contains the order of your rowsπ N => number of equationsπ ON Exit : Col_Mat => n/aπ X_MAt1 => your solutions !!!!!!!!!!!!!π Coeff_Mat1 => n/aπ order_Vect1 => who caresπ N => n/a ***)πππVarπ I, J : Integer; (* loop and indice of Array control *)π Sum : Real; (* used to sum each row's elements *)ππbeginπ X_Mat1[N] := Col_Mat1[order_Vect1[N]]/Coeff_Mat1[order_Vect1[N],N];π (***** This gives you the value of x[n] *********)ππ For I := N-1 downto 1 doπ beginπ Sum := 0.0;π For J := I+1 to N doπ Sum := Sum + Coeff_Mat1[order_Vect1[I],J]*X_Mat1[J];π X_Mat1[I] := (Col_Mat1[order_Vect1[I]] - Sum)/Coeff_Mat1[order_Vect1[I],I];π end;πend; (** Procedure substitute **)πππ{---------------------------------------------------------------------------}πππProcedure Output(X_Mat1: Col_Array; N : Integer);ππ(*** This Procedure outputs the solutions to the inputted system of ***)π(*** equations ***)π(*** ON ENTRY : X_Mat1 => the solutions to the system of equationsπ N => the number of equationsπ ON Exit : X_Mat1 => n/aπ N => n/a ***)πππVarπ I : Integer; (* loop control and Array indice *)ππbeginπ Writeln;Writeln;Writeln; (* skips lines *)π Writeln('The solutions to your sytem of equations are:');π For I := 1 to N doπ Writeln('X(',I,') := ',X_Mat1[I]);πend; (* Procedure /output *)ππππ{---------------------------------------------------------------------------}π(* *)π(* *)π(* *)π(***************************************************************************)ππbeginππ Repeatπ Instruct; (* calls Procedure Instruct *)π Initialize_Array(Coeff_Mat, Col_Mat, X_Mat, Scale_Vect, order_Vect);π (* calls Procedure Initialize_Array *)π Repeatπ Input(N_EQNS, Coeff_Mat, Col_Mat); (* calls Procedure Input *)π Check_Input(Coeff_Mat,N_EQNS,Ans); (* calls Procedure check_Input *)π Until Ans in ['Y','y']; (* loops Until user inputs correct matrix *)ππ order(Scale_Vect,order_Vect,Coeff_Mat,N_EQNS); (* calls Procedure order *)π Eliminate(Col_Mat,Scale_Vect,Coeff_Mat,order_Vect,N_EQNS); (*etc..*)π Substitute(Col_Mat,X_Mat,Coeff_Mat,order_Vect,N_EQNS); (*etc..*)π Output(X_Mat,N_EQNS); (*etc..*)ππ Writeln;π Write('Do you wish to solve another system of equations?(Y/N):');π readln(Ans);π Until Ans in ['N','n'];πππend. (*************** end of Program GAUSS_ELIMinATION *******************)π 6 05-28-9313:50ALL SWAG SUPPORT TEAM GCD.PAS IMPORT 3 {Greatest common divisor}πProgram GCD;ππVarπ x, y : Integer;ππbeginπ read(x);ππ While x <> 0 doπ beginπ read(y);ππ While x <> y doπ if x > y thenπ x := x - yπ elseπ y := y - x;ππ Write(x);π read(x);ππ end;πend.π 7 05-28-9313:50ALL SWAG SUPPORT TEAM LOGRITHM.PAS IMPORT 2 Function NlogX(X: Real; N:Real): Real;ππbeginπ NlogX = Ln(X) / Ln(N);πend;ππ 8 05-28-9313:50ALL SWAG SUPPORT TEAM MATHSPD.PAS IMPORT 10 {π> I was just wondering how to speed up some math-intensiveπ> routines I've got here. For example, I've got a Functionπ> that returns the distance between two Objects:ππ> Function Dist(X1,Y1,X2,Y2 : Integer) : Real;π> beginπ> Dist := Round(Sqrt(Sqr(X1-X2)+Sqr(Y1-Y2)));π> end;ππ> This is way to slow. I know assembly can speed it up, butπ> I know nothing about as. so theres the problem. Pleaseπ> help me out, any and all source/suggestions welcome!ππX1, Y1, X2, Y2 are all Integers. Integer math is faster than Real (justπabout anything is). Sqr and Sqrt are not Integer Functions. Try forπfun...π}ππFunction Dist( X1, Y1, X2, Y2 : Integer) : Real;πVarπ XTemp,π YTemp : Integer;π{ the allocation of these takes time. if you don't want that time taken,π make them global With care}πbeginπ XTemp := X1 - X2;π YTemp := Y1 - Y2;π Dist := Sqrt(XTemp * XTemp + YTemp * YTemp);πend;ππ{πif you have a math coprocessor or a 486dx, try using DOUBLE instead ofπReal, and make sure your compiler is set to compile For 287 (or 387).π}ππbeginπ Writeln('Distance Between (3,9) and (-2,-3) is: ', Dist(3,9,-2,-3) : 6 : 2);πend. 9 05-28-9313:50ALL SWAG SUPPORT TEAM PARSMATH.PAS IMPORT 19 │I'm writing a Program that draws equations. It's fairly easy if you putπ│the equation in a pascal Variable like Y := (X+10) * 2, but I would likeπ│the user to enter the equation, but I don't see any possible way to doπ│it.πππ ...One way of doing it is by using an "expression trees". Supposeπyou have the equation Y := 20 ÷ 2 + 3. In this equation, you can representπthe expression 20 ÷ 2 + 3 by using "full" binary trees as such:πππfigure 1 a ┌─┐π │+│ <----- root of your expressionπ └─┘π b / \π ┌─┐ ┌─┐ eπ │÷│ │3│π └─┘ └─┘π / \π c ┌──┐ ┌─┐ dπ │20│ │2│π └──┘ └─┘πππ(Note: a "leaf" is a node With no left or right children - ie: a value )ππ...The above expression are called infix arithmetic expressions; theπoperators are written in between the things on which they operate.ππIn our example, the nodes are visited in the order c, d, b, e, a, andπtheir Labels in this order are 20, 2, ÷, 3, +.πππFunction Evaluate(p: node): Integer;π{ return value of the expression represented by the tree With root p }π{ p - points to the root of the expression tree }πVarπ T1, T2: Integer;π op: Char;πbeginπ if (p^.left = nil) and (p^.right = nil) then { node is a "leaf" }π Evaluate := (p^.Value) { simple Case }π elseπ beginπ T1 := Evaluate(p^.Left);π T2 := Evaluate(p^.Right);π op := p^.Label;π { apply operation }π Case op ofπ '+': Evaluate := (T1 + T2);π '-': Evaluate := (T1 - T2);π '÷': Evaluate := (T1 div T2);π '*': Evaluate := (T1 * T2);π end;π endπend;πππ...Thus, using figure 1, we have:ππ ┌── ┌──π │ │ Evaluate(c) = 20π │ Evaluate(b) │ Evaluate(d) = 2π │ │ ApplyOp('÷',20,2) = 10π Evaluate(a)│ └──π │ Evaluate(e) = 3π │π │ ApplyOp('+',10,3) = 13π └─π 10 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA1.PAS IMPORT 8 {π> Does anyone have an idea to perform permutations With pascal 7.0 ?π> As an example finding the number of 5 card hands from a total of 52 cards.π> Any help would be greatly appreciated.ππThis Program should work fine. I tested it a few times and it seemed to work.πIt lets you call the Functions For permutation and combination just as youπwould Write them: P(n,r) and C(n,r).π}ππ{$E+,N+}πProgram CombPerm;ππVarπ Result:Extended;πFunction Factorial(Num: Integer): Extended;πVarπ Counter: Integer;π Total: Extended;πbeginπ Total:=1;π For Counter:=2 to Num doπ Total:=Total * Counter;π Factorial:=Total;πend;ππFunction P(N: Integer; R: Integer): Extended;πbeginπ P:=Factorial(N)/Factorial(N-R);πend;ππFunction C(N: Integer; R: Integer): Extended;πbeginπ C:=Factorial(N)/(Factorial(N-R)*Factorial(R));πend;ππbeginπ Writeln(P(52,5));πend. 11 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA2.PAS IMPORT 18 {πI'm working on some statistical process control Charts and amπlearning/using Pascal. The current Chart Uses permutations andπI have been successful in determing the number of combinationsπpossible, but I want to be able to choose a few of those possibleπcombinations at random For testing purposes.ππThrough some trial and error, I've written the following Programπwhich calculates the number of possible combinations of x digitsπwith a certain number of digits in each combination. For exampleπa set of 12 numbers With 6 digits in each combination gives anπanswer of 924 possible combinations. After all that, here is theπquestion: Is there a Formula which would calculate what those 924πcombinations are? (ie: 1,2,3,4,5,6 then 1,2,3,4,5,7 then 1,2,3,4,5,8π... 1,2,3,4,5,12 and so on? Any help would be appreciated and anyπcriticism will be accepted.π}ππProgram permutations;ππUses Crt;ππType hold_em_here = Array[1..15] of Integer;ππVar numbers,combs,bot2a : Integer;π ans,top,bot1,bot2b : Real;π hold_Array : hold_em_here;ππFunction permutate_this(number1 : Integer) : Real;πVar i : Integer;π a : Real;πbeginπ a := number1;π For i := (number1 - 1) doWNto 1 do a := a * i;π permutate_this := a;πend;ππProcedure input_numbers(Var hold_Array : hold_em_here; counter : Integer);πVar i,j : Integer;πbeginπ For i := 1 to counter do beginπ Write(' Input #',i:2,': ');π READLN(j);π hold_Array[i] := j;π end;πend;ππProcedure show_numbers(hold_Array : hold_em_here; counter : Integer);πVar i,j : Integer;πbeginπ WriteLN;π Write('Array looks like this: ');π For i := 1 to counter do Write(hold_Array[i]:3);π WriteLNπend;ππbeginπ ClrScr;π WriteLN;π WriteLN(' Permutations');π WriteLN;π Write(' Enter number of digits (1-15): ');π READLN(numbers);π Write('Enter number in combination (2-10): ');π READLN(combs);π top := permutate_this(numbers);π bot1 := permutate_this(combs);π bot2a := numbers - combs;π bot2b := permutate_this(bot2a);π ans := top/(bot1*bot2b);π WriteLN(' total permutations For above is: ',ans:3:0);π WriteLN;π input_numbers(hold_Array,numbers);π show_numbers(hold_Array,numbers);πEND. 12 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA3.PAS IMPORT 25 {π> I want to create all permutations.ππ Okay. I should have first asked if you Really mean permutaions.π Permutations mean possible orders. I seem to recall your orginal messageπ had to do With card hands. They usually involve combinations, notπ permutations. For example, all possible poker hands are the COMBinATIONSπ of 52 cards taken 5 at a time. Bridge hands are the combinations of 52π cards taken 13 at a time. if you master the following Program, you shouldπ be able to figure out how to create all combinations instead ofπ permutations.ππ However, if you mean permutations, here is an example Program to produceπ permutations. (You will have to alter it to your initial conditions.) Itπ involves a recursive process (a process which Uses itself). Recursiveπ processes are a little dangerous. It is easy to step on your ownπ privates writing them. They also can use a lot of stack memory. Youπ ought to be able to take the same general methods to produceπ combinations instead of permutations if need be.ππ I suggest you Compile and run the Program and see all the permutationsπ appear on the screen beFore reading further. (BTW, counts permutationsπ as well as producing them and prints out the count at the end.)ππ The Procedure Permut below rotates all possible items into the firstπ Array position. For each rotation it matches the item With all possibleπ permutations of the remaining positions. Permut does this by callingπ Permut For the Array of remaining positions, which is now one itemπ smaller. When the remaining Array is down to one position, only oneπ permutaion is possible, so the current Array is written out as one ofπ the results.ππ Once you get such a Program working, it is theoretically possible toπ convert any recursive Program to a non-recursive one. This often runsπ faster. Sometimes the conversion is not easy, however.ππ One final caution. The following Program Writes to the screen. You willπ see that as the number of items increases, the amount of outputπ increases tremendously. if you were to alter the Program to Writeπ results to a File and to allow more than 9 items, you could easilyπ create a File as big as your hard drive.π}ππProgram Permutes;ππUsesπ Crt;ππTypeπ TArry = Array[1..9] of Byte;ππVarπ Arry : TArry;π Size,X : Word;π NumbofPermutaions : LongInt;ππProcedure Permut(Arry : TArry; Position,Size : Word);πVarπ I,J : Word;π Swap: Byte;πbeginπ if Position = Size thenπ{ beginπ For I := 1 to Size doπ Write(Arry[I]:1);π} inc(NumbofPermutaions)π{ Writelnπ endπ} elseπ beginπ For J := Position to Size doπ beginπ Swap := Arry[J];π Arry[J] := Arry[Position];π Arry[Position] := Swap;π Permut(Arry,Position+1,Size)π endπ endπend;ππbeginπ ClrScr;π Write('How many elements (1 to 9)? ');π readln(Size);π ClrScr;π For X := 1 to Size doπ Arry[X] := X; {put item values in Array}π NumbofPermutaions := 0;π Permut(Arry,1,Size);π Writeln;π Writeln('Number of permutations = ',NumbofPermutaions);π Writeln('Press <Enter> to Exit.');π readlnπend.π 13 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA4.PAS IMPORT 5 {π> Does anyone have an idea to perForm permutations With pascal 7.0 ?π> As an example finding the number of 5 card hands from a total of 52 carπ> Any help would be greatly appreciated.ππ}ππFunction Permutation(things, atatime : Word) : LongInt;πVarπ i : Word;π temp : LongInt;πbeginπ temp := 1;π For i := 1 to atatime doπ beginπ temp := temp * things;π dec(things);π end;π Permutation := temp;πend;ππbeginπ Writeln('7p7 = ',Permutation(7,7));πend. 14 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA5.PAS IMPORT 11 {π>it. While I'm at it, does anyone have any ideas For an algorithm to generateπ>and test all possible combinations of a group of letters For Real Words.ππI'm sure it wouldn't take long to modify this Program I wrote, whichπproduces all combinations of "n" numbers.ππI got the idea from "Algorithms", by Robert Sedgewick. Recommended.π}πProgram ShowPerms;ππUsesπ Crt;ππConstπ digits = 4; {How many digits to permute: n digits = n! perms!}ππVarπ PermArray : Array [1..digits] of Byte; {Permutation holder}π ThisDigit : Integer;ππProcedure WritePerm;πVarπ loop : Byte;πbeginπ For loop := 1 to 4 doπ Write(PermArray[loop]);π Writeln;πend;ππProcedure PermuteAtLevel(Level : Integer);πVarπ loop : Integer;ππbeginπ inc(ThisDigit);π PermArray[Level] := ThisDigit;π if ThisDigit = digits thenπ Writeperm; {if we've accounted For all digits}π For loop := 1 to digits doπ if PermArray[loop] = 0 thenπ PermuteAtLevel(loop);π dec(ThisDigit);π PermArray[Level] := 0;πend;ππbeginπ ClrScr;π ThisDigit := -1; {Left of Left-hand-side}π FillChar (PermArray, sizeof(PermArray),#0); {Make it zeroes}π PermuteAtLevel(0); {Start at the bottom}πend.π- 15 05-28-9313:50ALL SWAG SUPPORT TEAM PI1.PAS IMPORT 13 {$N+}ππProgram CalcPI(input, output);ππ{ Not the most efficient Program I've ever written. Mostly it's quick andπ dirty. The infinite series is very effective converging very quickly.π It's much better than Pi/4 = 1 - 1/3 + 1/5 - 1/7 ... which convergesπ like molasses. }ππ{ Pi / 4 = 4 * (1/5 - 1/(3*5^3) + 1/(5*5^5) - 1/(7*5^7) + ...) -π (1/239 - 1/(3*239^3) + 1/(5*239^5) - 1/(7*239^7) + ...) }ππ{* Infinite series courtesy of Machin (1680 - 1752). I found it in myπ copy of Mathematics and the Imagination by Edward Kasner andπ James R. Newman (Simon and Schuster, New York 1940, p. 77) * }ππUsesπ Crt;πππVarπ Pi_Fourths,π Pi : Double;π Temp : Double;π ct : Integer;π num : Integer;πππFunction Power(Number, Exponent : Integer) : double;πVarπ ct : Integer;π temp : double;ππbeginπ temp := 1.00;π For ct := 1 to Exponent DOπ temp := temp * number;π Power := tempπend;ππbeginπ ClrScr;π ct := 1;π num := 1;π Pi_Fourths := 0;ππ While ct < 15 DOπ beginπ Temp := (1.0 / (Power(5, num) * num)) * 4;ππ if ct MOD 2 = 1 thenπ Pi_Fourths := Pi_Fourths + Tempπ ELSEπ Pi_Fourths := Pi_Fourths - Temp;ππ Temp := 1.0 / (Power(239, num) * num);ππ if ct MOD 2 = 1 thenπ Pi_Fourths := Pi_Fourths - Tempπ ELSEπ Pi_Fourths := Pi_Fourths + Temp;ππ ct := ct + 1;π num := num + 2;π end;ππ Pi := Pi_Fourths * 4.0;π Writeln( 'PI = ', Pi);πend.π 16 05-28-9313:50ALL SWAG SUPPORT TEAM PI2.PAS IMPORT 26 {π Here's a good (but a little slow) Program to calculate theπ decimals of Pi :πππTHIS Program CompUTES THE DIGITS of PI USinG THE ARCTANGENT ForMULAπ(1) PI/4 = 4 ARCTAN 1/5 - ARCTAN 1/239πin CONJUNCTION With THE GREGorY SERIESππ(2) ARCTAN X = SUM (-1)^N*(2N + 1)^-1*X^(2N+1) N=0 to inFinITY.ππSUBSTITUTinG into (2) A FEW VALUES of N and NESTinG WE HAVE,ππPI/4 = 1/5[4/1 + 1/25[-4/3 + 1/25[4/5 + 1/25[-4/7 + ...].].]ππ - 1/239[1/1 + 1/239^2[-1/3 + 1/239^2[1/5 + 1/239^2[-1/7 +...].].]ππUSinG THE LONG divISION ALGorITHM, THIS ( NESTED ) inFinITE SERIES CAN BEπUSED to CALCULATE PI to A LARGE NUMBER of DECIMAL PLACES in A REASONABLEπAMOUNT of TIME. A TIME Function IS inCLUDED to SHOW HOW SLOW THinGSπGET WHEN N IS LARGE. IMPROVEMENTS CAN BE MADE BY CHANGinG THE SIZE ofπTHE Array ELEMENTS HOWEVER IT GETS A BIT TRICKY.ππ}ππUsesπ Crt;ππVarπ B,C,V,P1,S,K,N,I,J,Q,M,M1,X,R,D : Integer;π P,A,T : Array[0..5000] of Integer;ππConst F1=5;πConst F2=239;πProcedure divIDE(D : Integer);π beginπ R:=0;π For J:=0 to M doπ beginπ V:= R*10+P[J];π Q:=V div D;π R:=V Mod D;π P[J]:=Q;π end;πend;πProcedure divIDEA(D : Integer);π beginπ R:=0;π For J:=0 to M doπ beginπ V:= R*10+A[J];π Q:=V div D;π R:=V Mod D;π A[J]:=Q;π end;π end;πProcedure SUBT;πbeginπB:=0;πFor J:=M Downto 0 doπ if T[J]>=A[J] then T[J]:=T[J]-A[J] elseπ beginπ T[J]:=10+T[J]-A[J];π T[J-1]:=T[J-1]-1;π end;πFor J:=0 to M doπA[J]:=T[J];πend;πProcedure SUBA;πbeginπFor J:=M Downto 0 doπ if P[J]>=A[J] then P[J]:=P[J]-A[J] elseπ beginπ P[J]:=10+P[J]-A[J];π P[J-1]:=P[J-1]-1;π end;πFor J:= M Downto 0 doπA[J]:=P[J];πend;πProcedure CLEARP;π beginπ For J:=0 to M doπ P[J]:=0;π end;πProcedure ADJUST;πbeginπP[0]:=3;πP[M]:=10;πFor J:=1 to M-1 doπP[J]:=9;πend;ππProcedure ADJUST2;πbeginπP[0]:=0;πP[M]:=10;πFor J:=1 to M-1 doπP[J]:=9;πend;ππProcedure MULT4;π beginπ C:=0;π For J:=M Downto 0 doπ beginπ P1:=4*A[J]+C;π A[J]:=P1 Mod 10;π C:=P1 div 10;π end;π end;ππProcedure SAVEA;πbeginπFor J:=0 to M doπT[J]:=A[J];πend;ππProcedure TERM1;πbeginπ I:=M+M+1;π A[0]:=4;πdivIDEA(I*25);πWhile I>3 doπbeginπI:=I-2;πCLEARP;πP[0]:=4;πdivIDE(I);πSUBA;πdivIDEA(25);πend;πCLEARP;πADJUST;πSUBA;πdivIDEA(5);πSAVEA;πend;πProcedure TERM2;πbeginπ I:=M+M+1;π A[0]:=1;πdivIDEA(I);πdivIDEA(239);πdivIDEA(239);πWhile I>3 doπbeginπI:=I-2;πCLEARP;πP[0]:=1;πdivIDE(I);πSUBA;πdivIDEA(239);πdivIDEA(239);πend;πCLEARP;πADJUST2;πSUBA;πdivIDEA(239);πSUBT;πend;ππ{MAin Program}ππ beginπ ClrScr;π WriteLn(' THE CompUTATION of PI');π WriteLn(' -----------------------------');π WriteLn('inPUT NO. DECIMAL PLACES');π READLN(M1);π M:=M1+4;π For J:=0 to M doπ beginπ A[J]:=0;π T[J]:=0;π end;π TERM1;π TERM2;π MULT4;π WriteLn;WriteLn;π Write('PI = 3.');π For J:=1 to M1 doπ beginπ Write(A[J]);π if J Mod 5 =0 then Write(' ');π if J Mod 50=0 then Write(' ');π end;π WriteLn;WriteLn;π WriteLn;πend.π 17 05-28-9313:50ALL SWAG SUPPORT TEAM PRIMES1.PAS IMPORT 12 {πSAM HASINOFFππLoopNum forget who first asked this question, but here is some code to helpπyou find your prime numbers in its entirety (tested):π}ππUsesπ Crt;ππLabelπ get_out;πVarπ LoopNum,π Count,π MinPrime,π MaxPrime,π PrimeCount : Integer;π Prime : Boolean;π max : String[20];π ECode : Integer;πbeginπ minprime := 0;π maxprime := 0;ππ ClrScr;π Write('Lower limit For prime number search [1]: ');π readln(max);π val(max, minprime, ECode);ππ if (minprime < 1) thenπ minprime := 1;π Repeatπ GotoXY(1, 2);π ClrEol;π Write('Upper limit: ');π readln(max);π val(max, maxprime, ECode);π Until (maxprime > minprime);ππ WriteLn;π PrimeCount := 0;ππ For LoopNum := minprime to maxprime doπ beginπ prime := True;π Count := 2;ππ While (Count <= (LoopNum div 2)) and (Prime) doπ beginπ if (LoopNum mod Count = 0) thenπ prime := False;π Inc(Count);π end;ππ if (Prime) thenπ beginπ Write('[');π TextColor(white);π Write(LoopNum);π TextColor(lightgray);π Write('] ');π Inc(PrimeCount);π if WhereX > 75 thenπ Write(#13#10);π end;π if WhereY = 24 thenπ beginπ Write('-- More --');π ReadKey;π ClrScr;π end;π prime := False;π end;π Write(#13#10#10);π Writeln(PrimeCount, ' primes found.', #13#10);πend.π 18 05-28-9313:50ALL SWAG SUPPORT TEAM PRIMES2.PAS IMPORT 9 {πBRIAN PAPEππ> Go to the library and look up the Sieve of Eratosthenes; it's a veryπ>interesting and easy method For "finding" prime numbers in a certainπ>range - and kinda fun to Program in Pascal, I might add...π}ππProgram aristophenses_net;π{π LCCC Computer Bowl November 1992 Team members:π Brian Pape, Mike Lazar, Brian Grammer, Kristy Reed - total time: 5:31π}ππConstπ size = 5000;πVarπ b : Array [1..size] of Boolean;π i, j,π count : Integer;ππbeginπ count := 0;π Writeln;π Write('WORKING: ', ' ' : 6, '/', size : 6);π For i := 1 to 13 doπ Write(#8);π fillChar(b, sizeof(b), 1);ππ For i := 2 to size doπ if b[i] thenπ beginπ Write(i : 6, #8#8#8#8#8#8);π For j := i + 1 to size doπ if j mod i = 0 thenπ b[j] := False;π end; { For }ππ Writeln;ππ For i := 1 to size doπ if b[i] thenπ beginπ Write(i : 8);π inc(count);π end;ππ Writeln;π Write('The number of primes from 1 to ', size, ' is ', count, '.');πend.ππ 19 05-28-9313:50ALL SWAG SUPPORT TEAM PRIMES3.PAS IMPORT 40 {π Hi, to All:ππ ...While recently "tuning up" one of my Programs I'm currentlyπ working on, I ran a little test to Compare the perfomanceπ of the different versions of Turbo Pascal from 5.0 throughπ to 7.0. The results were quite suprizing, and I thought I'dπ share this With you guys/gals.ππ Here are the results of a "sieve" Program to find all the primesπ in 1 - 100,000, running on my AMI 386SX-25 CPU desktop PC:ππ CompILER EXECUTION TIME RELATIVE TIME FACtoRπ ==================================================π TP 7.0 46.7 sec 1.00π TP 6.0 137.8 sec 2.95π TP 5.5 137.5 sec 2.94π TP 5.0 137.6 sec 2.95ππ Running the same Program to find all the primes in 1 - 10,000,π running on my 8086 - 9.54 Mhz NEC V20 CPU laptop PC:ππ CompILER EXECUTION TIME RELATIVE TIME FACtoRπ ==================================================π TP 7.0 14.1 sec 1.00π TP 6.0 28.3 sec 2.00ππ notE: This would seem to indicate that the TP 7.0 386 math-π library is kicking in when run on a 386 CPU.ππ Here is the source-code to my "seive" Program:π------------------------------------------------------------------------π}π {.$DEFinE DebugMode}π {$DEFinE SaveData}ππ {$ifDEF DebugMode}π {$ifDEF VER70}π {$ifDEF DPMI}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,P+,Q+,R+,S+,T+,V+,X-}π {$else}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,P+,Q+,R+,S+,T+,V+,X-}π {$endif}π {$else}π {$ifDEF VER60}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}π {$else}π {$A+,B-,D+,E-,F-,I+,L+,N-,O-,R+,S+,V+}π {$endif}π {$endif}π {$else}π {$ifDEF VER70}π {$ifDEF DPMI}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,P-,Q-,R-,S+,T-,V-,X-}π {$else}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}π {$endif}π {$else}π {$ifDEF VER60}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}π {$else}π {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S+,V-}π {$endif}π {$endif}π {$endif}ππ (* Find prime numbers - Guy McLoughlin, 1993. *)πProgram Find_Primes;ππ (***** Check if a number is prime. *)π (* *)π Function Prime({input } lo_in : LongInt) : {output} Boolean;π Varπ lo_Stop,π lo_Loop : LongInt;π beginπ if (lo_in mod 2 = 0) thenπ beginπ Prime := (lo_in = 2);π Exitπ end;π if (lo_in mod 3 = 0) thenπ beginπ Prime := (lo_in = 3);π Exitπ end;ππ if (lo_in mod 5 = 0) thenπ beginπ Prime := (lo_in = 5);π Exitπ end;π lo_Stop := 7;π While ((lo_Stop * lo_Stop) <= lo_in) doπ inc(lo_Stop, 2);π lo_Loop := 7;π While (lo_Loop < lo_Stop) doπ beginπ inc(lo_Loop, 2);π if (lo_in mod lo_Loop = 0) thenπ beginπ Prime := False;π Exitπ endπ end;π Prime := Trueπ end; (* Prime. *)ππ (***** Check For File IO errors. *)π (* *)π Procedure CheckIOerror;π Varπ by_Error : Byte;π beginπ by_Error := ioresult;π if (by_Error <> 0) thenπ beginπ Writeln('File Error = ', by_Error);π haltπ endπ end; (* CheckIOerror. *)ππVarπ bo_Temp : Boolean;π wo_PrimeCount : Word;π lo_Temp,π lo_Loop : LongInt;π fite_Data : Text;ππbeginπ lo_Temp := 100000;π {$ifDEF SaveData}π {$ifDEF VER50}π assign(fite_Data, 'PRIME.50');π {$endif}π {$ifDEF VER55}π assign(fite_Data, 'PRIME.55');π {$endif}π {$ifDEF VER60}π assign(fite_Data, 'PRIME.60');π {$endif}π {$ifDEF VER70}π assign(fite_Data, 'PRIME.70');π {$endif}π {$I-}π reWrite(fite_Data);π {$I+}π CheckIOerror;π {$endif}π wo_PrimeCount := 0;π For lo_Loop := 2 to lo_Temp doπ if Prime(lo_Loop) thenπ {$ifDEF SaveData}π beginπ Write(fite_Data, lo_Loop:6);π Write(fite_Data, ', ');π inc(wo_PrimeCount);π if ((wo_PrimeCount mod 10) = 0) thenπ Writeln(fite_Data)π end;π close(fite_Data);π CheckIOerror;π {$else}π inc(wo_PrimeCount);π {$endif}π Writeln(wo_PrimeCount, ' primes between: 1 - ', lo_Temp)πend.ππ{π ...This little test would put TP 7.0's .EXE's between 2 to 3π times faster than TP4 - TP6 .EXE's. (I've found simmilar resultsπ in testing other Programs I've written.) I guess this is one moreπ reason to upgrade to TP 7.0 .ππ ...I'd be curious to see how StonyBrook's Pascal+ 6.1 Comparesπ to TP 7.0, in terms of execution speed With this Program.ππ - Guyπ}π 20 05-28-9313:50ALL SWAG SUPPORT TEAM SQRT.PAS IMPORT 13 (***** Find the square-root of an Integer between 1..2,145,635,041 *)π(* *)πFunction FindSqrt({input} lo_in : LongInt) : {output} LongInt;ππ (***** SUB : Find square-root For numbers less than 65417. *)π (* *)π Function FS1({input } wo_in : Word) : {output} Word;π Varπ wo_Temp : Word;π beginπ wo_Temp := 1;π While ((wo_Temp * wo_Temp) < wo_in) doπ inc(wo_Temp, 11);π While((wo_Temp * wo_Temp) > wo_in) doπ dec(wo_Temp);π FS1 := wo_Tempπ end; (* SUB : FS1. *)ππ (***** SUB : Find square-root For numbers greater than 65416. *)π (* *)π Function FS2(lo_in : LongInt) : LongInt;π Varπ lo_Temp : LongInt;π beginπ lo_Temp := 1;π While ((lo_Temp * lo_Temp) < lo_in) doπ inc(lo_Temp, 24);π While((lo_Temp * lo_Temp) > lo_in) doπ dec(lo_Temp);π FS2 := lo_Tempπ end; (* SUB : FS2. *)ππbeginπ if (lo_in < 64517) thenπ FindSqrt := FS1(lo_in)π elseπ FindSqrt := FS2(lo_in)πend; (* FindSqrt. *)ππ{π ...I've now re-written the "seive" Program, and it appears to nowπ run about twice as fast. I'll post the new improved source-code inπ another message.π} 21 05-31-9308:04ALL FLOOR NAAIJKENS Trig & Calc Functions IMPORT 133 ==============================================================================π BBS: «« The Information and Technology Exchanπ To: JEFFREY HUNTSMAN Date: 11-27─91 (09:08)πFrom: FLOOR NAAIJKENS Number: 3162 [101] PASCALπSubj: CALC (1) Status: Publicπ------------------------------------------------------------------------------π{$O+}π{π F i l e I n f o r m a t i o nππ* DESCRIPTIONπSupplies missing trigonometric functions for Turbo Pascal 5.5. Alsoπprovides hyperbolic, logarithmic, power, and root functions. All trigπfunctions accessibile by radians, decimal degrees, degrees-minutes-secondsπand a global DegreeType.ππ}πunit PTD_Calc;ππ(* PTD_Calc - Supplies missing trigonometric functions for Turbo Pascal 5.5π * Also provides hyperbolic, logarithmic, power, and root functions.π * All trig functions accessible by radians, decimal degrees,π * degrees-minutes-seconds, and a global DegreeType. Conversionsπ * between these are supplied.π *π *)ππinterfaceππtypeπ DegreeType = recordπ Degrees, Minutes, Seconds : real;π end;πconstπ Infinity = 9.9999999999E+37;ππ{ Radians }π{ sin, cos, and arctan are predefined }ππfunction Tan( Radians : real ) : real;πfunction ArcSin( InValue : real ) : real;πfunction ArcCos( InValue : real ) : real;ππ{ Degrees, expressed as a real number }ππfunction DegreesToRadians( Degrees : real ) : real;πfunction RadiansToDegrees( Radians : real ) : real;πfunction Sin_Degree( Degrees : real ) : real;πfunction Cos_Degree( Degrees : real ) : real;πfunction Tan_Degree( Degrees : real ) : real;πfunction ArcSin_Degree( Degrees : real ) : real;πfunction ArcCos_Degree( Degrees : real ) : real;πfunction ArcTan_Degree( Degrees : real ) : real;ππ{ Degrees, in Degrees, Minutes, and Seconds, as real numbers }ππfunction DegreePartsToDegrees( Degrees, Minutes, Seconds : real ) : real;πfunction DegreePartsToRadians( Degrees, Minutes, Seconds : real ) : real;πprocedure DegreesToDegreeParts( DegreesIn : real;π var Degrees, Minutes, Seconds : real );πprocedure RadiansToDegreeParts( Radians : real;π var Degrees, Minutes, Seconds : real );πfunction Sin_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction Cos_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction Tan_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction ArcSin_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction ArcCos_DegreeParts( Degrees, Minutes, Seconds : real ) : real;πfunction ArcTan_DegreeParts( Degrees, Minutes, Seconds : real ) : real;ππ{ Degrees, expressed as DegreeType ( reals in record ) }ππfunction DegreeTypeToDegrees( DegreeVar : DegreeType ) : real;πfunction DegreeTypeToRadians( DegreeVar : DegreeType ) : real;πprocedure DegreeTypeToDegreeParts( DegreeVar : DegreeType;π var Degrees, Minutes, Seconds : real );πprocedure DegreesToDegreeType( Degrees : real; var DegreeVar : DegreeType );πprocedure RadiansToDegreeType( Radians : real; var DegreeVar : DegreeType );πprocedure DegreePartsToDegreeType( Degrees, Minutes, Seconds : real;π var DegreeVar : DegreeType );πfunction Sin_DegreeType( DegreeVar : DegreeType ) : real;πfunction Cos_DegreeType( DegreeVar : DegreeType ) : real;πfunction Tan_DegreeType( DegreeVar : DegreeType ) : real;πfunction ArcSin_DegreeType( DegreeVar : DegreeType ) : real;πfunction ArcCos_DegreeType( DegreeVar : DegreeType ) : real;πfunction ArcTan_DegreeType( DegreeVar : DegreeType ) : real;ππ{ Hyperbolic functions }ππfunction Sinh( Invalue : real ) : real;πfunction Cosh( Invalue : real ) : real;πfunction Tanh( Invalue : real ) : real;πfunction Coth( Invalue : real ) : real;πfunction Sech( Invalue : real ) : real;πfunction Csch( Invalue : real ) : real;πfunction ArcSinh( Invalue : real ) : real;πfunction ArcCosh( Invalue : real ) : real;πfunction ArcTanh( Invalue : real ) : real;πfunction ArcCoth( Invalue : real ) : real;πfunction ArcSech( Invalue : real ) : real;πfunction ArcCsch( Invalue : real ) : real;ππ{ Logarithms, Powers, and Roots }ππ{ e to the x is exp() }π{ natural log is ln() }πfunction Log10( InNumber : real ) : real;πfunction Log( Base, InNumber : real ) : real; { log of any base }πfunction Power( InNumber, Exponent : real ) : real;πfunction Root( InNumber, TheRoot : real ) : real;πππ{----------------------------------------------------------------------}πimplementationππconstπ RadiansPerDegree = 0.017453292520;π DegreesPerRadian = 57.295779513;π MinutesPerDegree = 60.0;π SecondsPerDegree = 3600.0;π SecondsPerMinute = 60.0;π LnOf10 = 2.3025850930;ππ{-----------}π{ Radians }π{-----------}ππ{ sin, cos, and arctan are predefined }ππfunction Tan { ( Radians : real ) : real };π { note: returns Infinity where appropriate }π varπ CosineVal : real;π TangentVal : real;π beginπ CosineVal := cos( Radians );π if CosineVal = 0.0 thenπ Tan := Infinityπ elseπ beginπ TangentVal := sin( Radians ) / CosineVal;π if ( TangentVal < -Infinity ) or ( TangentVal > Infinity ) thenπ Tan := Infinityπ elseπ Tan := TangentVal;π end;π end;ππfunction ArcSin{ ( InValue : real ) : real };π { notes: 1) exceeding input range of -1 through +1 will cause runtime error }π { 2) only returns principal values }π { ( -pi/2 through pi/2 radians ) ( -90 through +90 degrees ) }π beginπ if abs( InValue ) = 1.0 thenπ ArcSin := pi / 2.0π elseπ ArcSin := arctan( InValue / sqrt( 1 - InValue * InValue ) );π end;ππfunction ArcCos{ ( InValue : real ) : real };π { notes: 1) exceeding input range of -1 through +1 will cause runtime error }π { 2) only returns principal values }π { ( 0 through pi radians ) ( 0 through +180 degrees ) }π varπ Result : real;π beginπ if InValue = 0.0 thenπ ArcCos := pi / 2.0π elseπ beginπ Result := arctan( sqrt( 1 - InValue * InValue ) / InValue );π if InValue < 0.0 thenπ ArcCos := Result + piπ elseπ ArcCos := Result;π end;π end;ππ{---------------------------------------}π{ Degrees, expressed as a real number }π{---------------------------------------}ππfunction DegreesToRadians{ ( Degrees : real ) : real };π beginπ DegreesToRadians := Degrees * RadiansPerDegree;π end;ππfunction RadiansToDegrees{ ( Radians : real ) : real };π beginπ RadiansToDegrees := Radians * DegreesPerRadian;π end;ππfunction Sin_Degree{ ( Degrees : real ) : real };π beginπ Sin_Degree := sin( DegreesToRadians( Degrees ) );π end;ππfunction Cos_Degree{ ( Degrees : real ) : real };π beginπ Cos_Degree := cos( DegreesToRadians( Degrees ) );π end;ππfunction Tan_Degree{ ( Degrees : real ) : real };π beginπ Tan_Degree := Tan( DegreesToRadians( Degrees ) );ππ<ORIGINAL MESSAGE OVER 200 LINES, SPLIT IN 2 OR MORE>π==============================================================================π BBS: «« The Information and Technology Exchanπ To: JEFFREY HUNTSMAN Date: 11-27─91 (09:08)πFrom: FLOOR NAAIJKENS Number: 3163 [101] PASCALπSubj: CALC (1) <CONT> Status: Publicπ------------------------------------------------------------------------------π end;ππfunction ArcSin_Degree{ ( Degrees : real ) : real };π beginπ ArcSin_Degree := ArcSin( DegreesToRadians( Degrees ) );π end;ππfunction ArcCos_Degree{ ( Degrees : real ) : real };π beginπ ArcCos_Degree := ArcCos( DegreesToRadians( Degrees ) );π end;ππfunction ArcTan_Degree{ ( Degrees : real ) : real };π beginπ ArcTan_Degree := arctan( DegreesToRadians( Degrees ) );π end;ππ--- D'Bridge 1.30 demo/922115π * Origin: EURO-ONLINE Home of The Fast Commander (2:500/233)π==============================================================================π BBS: «« The Information and Technology Exchanπ To: JEFFREY HUNTSMAN Date: 11-27─91 (09:08)πFrom: FLOOR NAAIJKENS Number: 3164 [101] PASCALπSubj: CALC (2) Status: Publicπ------------------------------------------------------------------------------ππ{--------------------------------------------------------------}π{ Degrees, in Degrees, Minutes, and Seconds, as real numbers }π{--------------------------------------------------------------}ππfunction DegreePartsToDegrees{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ DegreePartsToDegrees := Degrees + ( Minutes / MinutesPerDegree ) +π ( Seconds / SecondsPerDegree );π end;ππfunction DegreePartsToRadians{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ DegreePartsToRadians := DegreesToRadians( DegreePartsToDegrees( Degrees,π Minutes, Seconds ) );π end;ππprocedure DegreesToDegreeParts{ ( DegreesIn : real;π var Degrees, Minutes, Seconds : real ) };π beginπ Degrees := int( DegreesIn );π Minutes := ( DegreesIn - Degrees ) * MinutesPerDegree;π Seconds := frac( Minutes );π Minutes := int( Minutes );π Seconds := Seconds * SecondsPerMinute;π end;ππprocedure RadiansToDegreeParts{ ( Radians : real;π var Degrees, Minutes, Seconds : real ) };π beginπ DegreesToDegreeParts( RadiansToDegrees( Radians ),π Degrees, Minutes, Seconds );π end;ππfunction Sin_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ Sin_DegreeParts := sin( DegreePartsToRadians( Degrees, Minutes, Seconds ) );π end;ππfunction Cos_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ Cos_DegreeParts := cos( DegreePartsToRadians( Degrees, Minutes, Seconds ) );π end;ππfunction Tan_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ Tan_DegreeParts := Tan( DegreePartsToRadians( Degrees, Minutes, Seconds ) );π end;ππfunction ArcSin_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ ArcSin_DegreeParts := ArcSin( DegreePartsToRadians( Degrees,π Minutes, Seconds ) );π end;ππfunction ArcCos_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ ArcCos_DegreeParts := ArcCos( DegreePartsToRadians( Degrees,π Minutes, Seconds ) );π end;ππfunction ArcTan_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };π beginπ ArcTan_DegreeParts := arctan( DegreePartsToRadians( Degrees,π Minutes, Seconds ) );π end;ππ{-------------------------------------------------------}π{ Degrees, expressed as DegreeType ( reals in record ) }π{-------------------------------------------------------}ππfunction DegreeTypeToDegrees{ ( DegreeVar : DegreeType ) : real };π beginπ DegreeTypeToDegrees := DegreePartsToDegrees( DegreeVar.Degrees,π DegreeVar.Minutes, DegreeVar.Seconds );π end;ππfunction DegreeTypeToRadians{ ( DegreeVar : DegreeType ) : real };π beginπ DegreeTypeToRadians := DegreesToRadians( DegreeTypeToDegrees( DegreeVar ) );π end;ππprocedure DegreeTypeToDegreeParts{ ( DegreeVar : DegreeType;π var Degrees, Minutes, Seconds : real ) };π beginπ Degrees := DegreeVar.Degrees;π Minutes := DegreeVar.Minutes;π Seconds := DegreeVar.Seconds;π end;ππprocedure DegreesToDegreeType{ ( Degrees : real; var DegreeVar : DegreeType )};π beginπ DegreesToDegreeParts( Degrees, DegreeVar.Degrees,π DegreeVar.Minutes, DegreeVar.Seconds );π end;ππprocedure RadiansToDegreeType{ ( Radians : real; var DegreeVar : DegreeType )};π beginπ DegreesToDegreeParts( RadiansToDegrees( Radians ), DegreeVar.Degrees,π DegreeVar.Minutes, DegreeVar.Seconds );π end;ππprocedure DegreePartsToDegreeType{ ( Degrees, Minutes, Seconds : real;π var DegreeVar : DegreeType ) };π beginπ DegreeVar.Degrees := Degrees;π DegreeVar.Minutes := Minutes;π DegreeVar.Seconds := Seconds;π end;ππfunction Sin_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ Sin_DegreeType := sin( DegreeTypeToRadians( DegreeVar ) );π end;ππfunction Cos_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ Cos_DegreeType := cos( DegreeTypeToRadians( DegreeVar ) );π end;ππfunction Tan_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ Tan_DegreeType := Tan( DegreeTypeToRadians( DegreeVar ) );π end;ππ--- D'Bridge 1.30 demo/922115π * Origin: EURO-ONLINE Home of The Fast Commander (2:500/233)π==============================================================================π BBS: «« The Information and Technology Exchanπ To: JEFFREY HUNTSMAN Date: 11-27─91 (09:08)πFrom: FLOOR NAAIJKENS Number: 3165 [101] PASCALπSubj: CALC (3) Status: Publicπ------------------------------------------------------------------------------πfunction ArcSin_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ ArcSin_DegreeType := ArcSin( DegreeTypeToRadians( DegreeVar ) );π end;ππfunction ArcCos_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ ArcCos_DegreeType := ArcCos( DegreeTypeToRadians( DegreeVar ) );π end;ππfunction ArcTan_DegreeType{ ( DegreeVar : DegreeType ) : real };π beginπ ArcTan_DegreeType := arctan( DegreeTypeToRadians( DegreeVar ) );π end;ππ{------------------------}π{ Hyperbolic functions }π{------------------------}ππfunction Sinh{ ( Invalue : real ) : real };π constπ MaxValue = 88.029691931; { exceeds standard turbo precision }π varπ Sign : real;π beginπ Sign := 1.0;π if Invalue < 0 thenπ beginπ Sign := -1.0;π Invalue := -Invalue;π end;π if Invalue > MaxValue thenπ Sinh := Infinityπ elseπ Sinh := ( exp( Invalue ) - exp( -Invalue ) ) / 2.0 * Sign;π end;ππfunction Cosh{ ( Invalue : real ) : real };π constπ MaxValue = 88.029691931; { exceeds standard turbo precision }π beginπ Invalue := abs( Invalue );π if Invalue > MaxValue thenπ Cosh := Infinityπ elseπ Cosh := ( exp( Invalue ) + exp( -Invalue ) ) / 2.0;π end;ππfunction Tanh{ ( Invalue : real ) : real };π beginπ Tanh := Sinh( Invalue ) / Cosh( Invalue );π end;ππfunction Coth{ ( Invalue : real ) : real };π beginπ Coth := Cosh( Invalue ) / Sinh( Invalue );π end;ππfunction Sech{ ( Invalue : real ) : real };π beginπ Sech := 1.0 / Cosh( Invalue );π end;ππfunction Csch{ ( Invalue : real ) : real };π beginπ Csch := 1.0 / Sinh( Invalue );π end;ππfunction ArcSinh{ ( Invalue : real ) : real };π varπ Sign : real;π beginπ Sign := 1.0;π if Invalue < 0 thenπ beginπ Sign := -1.0;π Invalue := -Invalue;π end;π ArcSinh := ln( Invalue + sqrt( Invalue*Invalue + 1 ) ) * Sign;π end;ππfunction ArcCosh{ ( Invalue : real ) : real };π varπ Sign : real;π beginπ Sign := 1.0;π if Invalue < 0 thenπ beginπ Sign := -1.0;π Invalue := -Invalue;π end;π ArcCosh := ln( Invalue + sqrt( Invalue*Invalue - 1 ) ) * Sign;π end;ππfunction ArcTanh{ ( Invalue : real ) : real };π varπ Sign : real;π beginπ Sign := 1.0;π if Invalue < 0 thenπ beginπ Sign := -1.0;π Invalue := -Invalue;π end;π ArcTanh := ln( ( 1 + Invalue ) / ( 1 - Invalue ) ) / 2.0 * Sign;π end;ππfunction ArcCoth{ ( Invalue : real ) : real };π beginπ ArcCoth := ArcTanh( 1.0 / Invalue );π end;ππfunction ArcSech{ ( Invalue : real ) : real };π beginπ ArcSech := ArcCosh( 1.0 / Invalue );π end;ππfunction ArcCsch{ ( Invalue : real ) : real };π beginπ ArcCsch := ArcSinh( 1.0 / Invalue );π end;ππ{---------------------------------}π{ Logarithms, Powers, and Roots }π{---------------------------------}ππ{ e to the x is exp() }π{ natural log is ln() }ππfunction Log10{ ( InNumber : real ) : real };π beginπ Log10 := ln( InNumber ) / LnOf10;π end;ππfunction Log{ ( Base, InNumber : real ) : real }; { log of any base }π beginπ Log := ln( InNumber ) / ln( Base );π end;ππfunction Power{ ( InNumber, Exponent : real ) : real };π beginπ if InNumber > 0.0 thenπ Power := exp( Exponent * ln( InNumber ) )π else if InNumber = 0.0 thenπ Power := 1.0π else { WE DON'T force a runtime error, we define a function to provideπ negative logarithms! }π If Exponent=Trunc(Exponent) Thenπ Power := (-2*(Trunc(Exponent) Mod 2)+1) * Exp(Exponent * Ln( -InNumber ) )π Else Power := Trunc(1/(Exponent-Exponent));π { NOW WE generate a runtime error }π end;ππfunction Root{ ( InNumber, TheRoot : real ) : real };π beginπ Root := Power( InNumber, ( 1.0 / TheRoot ) );π end;ππend. { unit PTD_Calc }ππππππP.S. Enjoy yourself!ππ--- D'Bridge 1.30 demo/922115π * Origin: EURO-ONLINE Home of The Fast Commander (2:500/233)π 22 06-22-9309:14ALL SWAG SUPPORT TEAM Factoral Program IMPORT 35 PROGRAM Fact;π{************************************************π* FACTOR - Lookup table demonstration using the *π* factorial series. *π* *π*************************************************}ππ{$N+,E+} {Set so you can use other real types}πUSES Crt,Dos,Timer; { t1Start, t1Get, t1Format }πCONSTπ BigFact = 500; {largest factorial is for 1754}πTYPE {defined type for file definition later}π TableType = ARRAY [0..BigFact] OF Extended;πVARπ Table : TableType;ππ{************************************************π* factorial - compute the factorial of a number *π* *π* INP: i - the # to compute the factorial of *π* OUT: The factorial of the number, unless a *π* number greater than BIG_FACT or less *π* than zero is passed in (which results *π* in 0.0). *π*************************************************}ππFUNCTION Factorial(I: Integer): Extended;πVARπ K : Integer;π F : Extended;πBEGINπ IF I = 0 THENπ F := 1π ELSEπ BEGINπ IF (I > 0) AND (I <= BigFact) THENπ BEGINπ F := 1;π FOR K := 1 TO I DOπ F := F * Kπ ENDπ ELSEπ F := 0π END;π Factorial := FπEND;ππ{************************************************π* Main - generate & save table of factorials *π*************************************************}ππVARπ I, J, N : Integer;π F : Extended;π T1, T2, T3 : Longint;π Facts : FILE OF TableType;πBEGINπ { STEP 1 - compute each factorial 5 times }π ClrScr;π WriteLn('Now computing each factorial 5 times');π T1 := tStart;π FOR I :=0 TO 4 DOπ FOR J := 0 TO BigFact DOπ F := Factorial(J); { f=j! }π T2 := tGet;π WriteLn('Computing all factorials from 0..n ');π WriteLn('5 times took ',tFormat(T1,T2),π ' secs.');π WriteLn;π { STEP 2 - compute the table, then look upπ each factorial 5 times. }π WriteLn('Now compute table and look up each ',π 'factorial 5 times.');π T1 := tStart;π FOR I := 0 TO BigFact DOπ Table[I] := Factorial(I);π T2 := tGet;π FOR I := 0 TO 4 DOπ FOR J :=0 TO BigFact DOπ F := Table[J]; { f=j! }π T3 := tGet;π WriteLn('Computing table took ',tFormat(T1,T2),π ' seconds');π WriteLn('Looking up each factorial 5 times to',π 'ok ',tFormat(T2,T3),' seconds');π WriteLn('Total: ',tFormat(T1,T3),' seconds');π WriteLn;π{STEP 3 - Compute each factorial as it is needed}π WriteLn('Clearing the table,',π ' and computing each ');π WriteLn('factorial as it is needed',π ' (for 5) lookups.');π WriteLn;π T1 := tStart;π FOR I := 0 TO BigFact DOπ Table[I] := -1; { unknown Val }π FOR I := 0 TO 4 DOπ FOR J := 0 TO BigFact DOπ BEGINπ F := Table[J];π IF F < 0 THENπ BEGINπ F := Factorial(J);π Table[J] := F { F = J! }π ENDπ END;π T2 := tGet;π WriteLn('Clearing table and computing each');π WriteLn(' factorial as it was needed for 5');π WriteLn('lookups took ',tFormat(T1,T2),π ' secs.');π { STEP 4 - write the table to disk (we areπ not timing this step, because if you areπ loading it from disk, you presumably do notπ care how long it took to compute it. }π Assign(Facts,'Fact_tbl.tmp');π Rewrite(Facts);π Write(Facts,Table);π Close(Facts);π { Flush the disk buffer, so that the timeπ is not affected by having the data in aπ disk buffer. }π Exec('C:\COMMAND.COM','/C CHKDSK');π { STEP 5 - read the table from disk, andπ use each factorial 5 times }π T1 := tStart;π Assign(Facts,'Fact_tbl.TMP');π Reset(Facts);π Read(Facts,Table);π Close(Facts);π T2 := tGet;π FOR I := 0 TO 4 DOπ FOR J :=0 TO BigFact DOπ F := Table[J]; { f=j! }π T3 := tGet;π WriteLn('Reading the Table from disk took ',π tFormat(T1,T2),' seconds.');π WriteLn('Looking up each Factorial 5 times ',π 'to ok took ',tFormat(T2,T3),' seconds.');π WriteLn('Total: ',tFormat(T1,T3),' seconds.');π WriteLn;π WriteLn('Press Enter TO see the factorials');π ReadLN;π FOR I:=0 TO BigFact DOπ WriteLn('[',I,'] = ',Table[I]);πend.π 23 07-17-9307:28ALL GAYLE DAVIS Math Conversion Unit IMPORT 64 ₧ { MATH Unit for various conversions }π{$DEFINE Use8087} { define this for EXTENDED 8087 floating point math }ππUNIT MATH;ππ{$IFDEF Use8087}π{$N+}π{$ELSEπ{$N-}π{$ENDIF}ππINTERFACEππTYPEπ {$IFDEF Use8087}π FLOAT = EXTENDED;π {$ELSE}π FLOAT = REAL;π {$ENDIF}ππFUNCTION FahrToCent(FahrTemp: FLOAT): FLOAT;πFUNCTION CentToFahr(CentTemp: FLOAT): FLOAT;πFUNCTION KelvToCent(KelvTemp: FLOAT): FLOAT;πFUNCTION CentToKelv(CentTemp: FLOAT): FLOAT;πPROCEDURE InchToFtIn(Inches: FLOAT; VAR ft,ins: FLOAT);πFUNCTION FtInToInch(ft,ins: FLOAT): FLOAT;πFUNCTION InchToYard(Inches: FLOAT): FLOAT;πFUNCTION YardToInch(Yards: FLOAT): FLOAT;πFUNCTION InchToMile(Inches: FLOAT): FLOAT;πFUNCTION MileToInch(Miles: FLOAT): FLOAT;πFUNCTION InchToNautMile(Inches: FLOAT): FLOAT;πFUNCTION NautMileToInch(NautMiles: FLOAT): FLOAT;πFUNCTION InchToMeter(Inches: FLOAT): FLOAT;πFUNCTION MeterToInch(Meters: FLOAT): FLOAT;πFUNCTION SqInchToSqFeet(SqInches: FLOAT): FLOAT;πFUNCTION SqFeetToSqInch(SqFeet: FLOAT): FLOAT;πFUNCTION SqInchToSqYard(SqInches: FLOAT): FLOAT;πFUNCTION SqYardToSqInch(SqYards: FLOAT): FLOAT;πFUNCTION SqInchToSqMile(SqInches: FLOAT): FLOAT;πFUNCTION SqMileToSqInch(SqMiles: FLOAT): FLOAT;πFUNCTION SqInchToAcre(SqInches: FLOAT): FLOAT;πFUNCTION AcreToSqInch(Acres: FLOAT): FLOAT;πFUNCTION SqInchToSqMeter(SqInches: FLOAT): FLOAT;πFUNCTION SqMeterToSqInch(SqMeters: FLOAT): FLOAT;πFUNCTION CuInchToCuFeet(CuInches: FLOAT): FLOAT;πFUNCTION CuFeetToCuInch(CuFeet: FLOAT): FLOAT;πFUNCTION CuInchToCuYard(CuInches: FLOAT): FLOAT;πFUNCTION CuYardToCuInch(CuYards: FLOAT): FLOAT;πFUNCTION CuInchToCuMeter(CuInches: FLOAT): FLOAT;πFUNCTION CuMeterToCuInch(CuMeters: FLOAT): FLOAT;πFUNCTION FluidOzToPint(FluidOz: FLOAT): FLOAT;πFUNCTION PintToFluidOz(Pints: FLOAT): FLOAT;πFUNCTION FluidOzToImpPint(FluidOz: FLOAT): FLOAT;πFUNCTION ImpPintToFluidOz(ImpPints: FLOAT): FLOAT;πFUNCTION FluidOzToGals(FluidOz: FLOAT): FLOAT;πFUNCTION GalsToFluidOz(Gals: FLOAT): FLOAT;πFUNCTION FluidOzToImpGals(FluidOz: FLOAT): FLOAT;πFUNCTION ImpGalsToFluidOz(ImpGals: FLOAT): FLOAT;πFUNCTION FluidOzToCuMeter(FluidOz: FLOAT): FLOAT;πFUNCTION CuMeterToFluidOz(CuMeters: FLOAT): FLOAT;πPROCEDURE OunceToLbOz(Ounces: FLOAT; VAR lb,oz: FLOAT);πFUNCTION LbOzToOunce(lb,oz: FLOAT): FLOAT;πFUNCTION OunceToTon(Ounces: FLOAT): FLOAT;πFUNCTION TonToOunce(Tons: FLOAT): FLOAT;πFUNCTION OunceToLongTon(Ounces: FLOAT): FLOAT;πFUNCTION LongTonToOunce(LongTons: FLOAT): FLOAT;πFUNCTION OunceToGram(Ounces: FLOAT): FLOAT;πFUNCTION GramToOunce(Grams: FLOAT): FLOAT;ππππIMPLEMENTATIONππ{ Temperature conversion }ππFUNCTION FahrToCent(FahrTemp: FLOAT): FLOAT;ππ BEGINπ FahrToCent:=(FahrTemp+40.0)*(5.0/9.0)-40.0;π END;πππFUNCTION CentToFahr(CentTemp: FLOAT): FLOAT;ππ BEGINπ CentToFahr:=(CentTemp+40.0)*(9.0/5.0)-40.0;π END;πππFUNCTION KelvToCent(KelvTemp: FLOAT): FLOAT;ππ BEGINπ KelvToCent:=KelvTemp-273.16;π END;πππFUNCTION CentToKelv(CentTemp: FLOAT): FLOAT;ππ BEGINπ CentToKelv:=CentTemp+273.16;π END;ππππ{ Linear measurement conversion }ππPROCEDURE InchToFtIn(Inches: FLOAT; VAR ft,ins: FLOAT);ππ BEGINπ ft:=INT(Inches/12.0);π ins:=Inches-ft*12.0;π END;πππFUNCTION FtInToInch(ft,ins: FLOAT): FLOAT;ππ BEGINπ FtInToInch:=ft*12.0+ins;π END;πππFUNCTION InchToYard(Inches: FLOAT): FLOAT;ππ BEGINπ InchToYard:=Inches/36.0;π END;πππFUNCTION YardToInch(Yards: FLOAT): FLOAT;ππ BEGINπ YardToInch:=Yards*36.0;π END;πππFUNCTION InchToMile(Inches: FLOAT): FLOAT;ππ BEGINπ InchToMile:=Inches/63360.0;π END;πππFUNCTION MileToInch(Miles: FLOAT): FLOAT;ππ BEGINπ MileToInch:=Miles*63360.0;π END;πππFUNCTION InchToNautMile(Inches: FLOAT): FLOAT;ππ BEGINπ InchToNautMile:=Inches/72960.0;π END;πππFUNCTION NautMileToInch(NautMiles: FLOAT): FLOAT;ππ BEGINπ NautMileToInch:=NautMiles*72960.0;π END;πππFUNCTION InchToMeter(Inches: FLOAT): FLOAT;ππ BEGINπ InchToMeter:=Inches*0.0254;π END;πππFUNCTION MeterToInch(Meters: FLOAT): FLOAT;ππ BEGINπ MeterToInch:=Meters/0.0254;π END;ππππ{ Area conversion }ππFUNCTION SqInchToSqFeet(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToSqFeet:=SqInches/144.0;π END;πππFUNCTION SqFeetToSqInch(SqFeet: FLOAT): FLOAT;ππ BEGINπ SqFeetToSqInch:=SqFeet*144.0;π END;πππFUNCTION SqInchToSqYard(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToSqYard:=SqInches/1296.0;π END;πππFUNCTION SqYardToSqInch(SqYards: FLOAT): FLOAT;ππ BEGINπ SqYardToSqInch:=SqYards*1296.0;π END;πππFUNCTION SqInchToSqMile(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToSqMile:=SqInches/4.0144896E9;π END;πππFUNCTION SqMileToSqInch(SqMiles: FLOAT): FLOAT;ππ BEGINπ SqMileToSqInch:=SqMiles*4.0144896E9;π END;πππFUNCTION SqInchToAcre(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToAcre:=SqInches/6272640.0;π END;πππFUNCTION AcreToSqInch(Acres: FLOAT): FLOAT;ππ BEGINπ AcreToSqInch:=Acres*6272640.0;π END;πππFUNCTION SqInchToSqMeter(SqInches: FLOAT): FLOAT;ππ BEGINπ SqInchToSqMeter:=SqInches/1550.016;π END;πππFUNCTION SqMeterToSqInch(SqMeters: FLOAT): FLOAT;ππ BEGINπ SqMeterToSqInch:=SqMeters*1550.016;π END;ππππ{ Volume conversion }ππFUNCTION CuInchToCuFeet(CuInches: FLOAT): FLOAT;ππ BEGINπ CuInchToCuFeet:=CuInches/1728.0;π END;πππFUNCTION CuFeetToCuInch(CuFeet: FLOAT): FLOAT;ππ BEGINπ CuFeetToCuInch:=CuFeet*1728.0;π END;πππFUNCTION CuInchToCuYard(CuInches: FLOAT): FLOAT;ππ BEGINπ CuInchToCuYard:=CuInches/46656.0;π END;πππFUNCTION CuYardToCuInch(CuYards: FLOAT): FLOAT;ππ BEGINπ CuYardToCuInch:=CuYards*46656.0;π END;πππFUNCTION CuInchToCuMeter(CuInches: FLOAT): FLOAT;ππ BEGINπ CuInchToCuMeter:=CuInches/61022.592;π END;πππFUNCTION CuMeterToCuInch(CuMeters: FLOAT): FLOAT;ππ BEGINπ CuMeterToCuInch:=CuMeters*61022.592;π END;πππ{ Liquid measurement conversion }ππFUNCTION FluidOzToPint(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToPint:=FluidOz/16.0;π END;πππFUNCTION PintToFluidOz(Pints: FLOAT): FLOAT;ππ BEGINπ PintToFluidOz:=Pints*16.0;π END;πππFUNCTION FluidOzToImpPint(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToImpPint:=FluidOz/20.0;π END;πππFUNCTION ImpPintToFluidOz(ImpPints: FLOAT): FLOAT;ππ BEGINπ ImpPintToFluidOz:=ImpPints*20.0;π END;πππFUNCTION FluidOzToGals(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToGals:=FluidOz/128.0;π END;πππFUNCTION GalsToFluidOz(Gals: FLOAT): FLOAT;ππ BEGINπ GalsToFluidOz:=Gals*128.0;π END;πππFUNCTION FluidOzToImpGals(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToImpGals:=FluidOz/160.0;π END;πππFUNCTION ImpGalsToFluidOz(ImpGals: FLOAT): FLOAT;ππ BEGINπ ImpGalsToFluidOz:=ImpGals*160.0;π END;πππFUNCTION FluidOzToCuMeter(FluidOz: FLOAT): FLOAT;ππ BEGINπ FluidOzToCuMeter:=FluidOz/33820.0;π END;πππFUNCTION CuMeterToFluidOz(CuMeters: FLOAT): FLOAT;ππ BEGINπ CuMeterToFluidOz:=CuMeters*33820.0;π END;πππ{ Weight conversion }ππPROCEDURE OunceToLbOz(Ounces: FLOAT; VAR lb,oz: FLOAT);ππ BEGINπ lb:=INT(Ounces/16.0);π oz:=Ounces-lb*16.0;π END;πππFUNCTION LbOzToOunce(lb,oz: FLOAT): FLOAT;ππ BEGINπ LbOzToOunce:=lb*16.0+oz;π END;πππFUNCTION OunceToTon(Ounces: FLOAT): FLOAT;ππ BEGINπ OunceToTon:=Ounces/32000.0;π END;πππFUNCTION TonToOunce(Tons: FLOAT): FLOAT;ππ BEGINπ TonToOunce:=Tons*32000.0;π END;πππFUNCTION OunceToLongTon(Ounces: FLOAT): FLOAT;ππ BEGINπ OunceToLongTon:=Ounces/35840.0;π END;πππFUNCTION LongTonToOunce(LongTons: FLOAT): FLOAT;ππ BEGINπ LongTonToOunce:=LongTons*35840.0;π END;πππFUNCTION OunceToGram(Ounces: FLOAT): FLOAT;ππ BEGINπ OunceToGram:=Ounces*28.35;π END;πππFUNCTION GramToOunce(Grams: FLOAT): FLOAT;ππ BEGINπ GramToOunce:=Grams/28.35;π END;πππEND.ππ 24 08-27-9321:17ALL LOU DUCHEZ Factoring Program IMPORT 8 ₧ {LOU DUCHEZππ> Could anybody explain how to Write such a routine in Pascal?ππHere's a dorky little "Factoring" Program I wrote to display the factorsπof a number:π}ππProgram factors;πVarπ lin,π lcnt : LongInt;πbeginπ Write('Enter number to factor: ');π readln(lin);π lcnt := 2;π While lcnt * lcnt <= lin doπ beginπ if lin mod lcnt = 0 thenπ Writeln('Factors:', lcnt : 9, (lin div lcnt) : 9);π lcnt := lcnt + 1;π end;πend.ππ{πNotice that I only check For factors up to the square root of the numberπTyped in. Also, notice the "mod" operator: gives the remainder of Integerπdivision ("div" gives the Integer result of division).ππNot Really knowing exactly what you want to accomplish, I don't Really knowπif the above is of much help. But what the hey.π} 25 08-27-9321:29ALL SEAN PALMER Dividing Fixed Integers IMPORT 12 ₧ {πSEAN PALMERππI'm using TP. Here are the fixed division routines I'm currently usingπ(they are, as you can see, quite specialized)ππI had to abandon the original fixed division routines because I didn'tπknow how to translate the 386-specific instructions using DB. (MOVSX,πSHLD, etc)π}ππtypeπ fixed = recordπ f : word;π i : integer;π end;ππ shortFixed = recordπ f : byte;π i : shortint;π end;ππ{ this one divides a fixed by a fixed, result is fixed needs 386 }ππfunction fixedDiv(d1, d2 : longint) : longint; assembler;πasmπ db $66; xor dx, dxπ mov cx, word ptr D1 + 2π or cx, cxπ jns @Sπ db $66; dec dxπ @S:π mov dx, cxπ mov ax, word ptr D1π db $66; shl ax, 16π db $66; idiv word ptr d2π db $66; mov dx, axπ db $66; shr dx, 16πend;ππ{ this one divides a longint by a longint, result is fixed needs 386 }ππfunction div2Fixed(d1, d2 : longint) : longint; assembler;πasmπ db $66; xor dx, dxπ db $66; mov ax, word ptr d1π db $66; shl ax, 16π jns @S;π db $66; dec dxπ @S:π db $66; idiv word ptr d2π db $66; mov dx, axπ db $66; shr dx, 16πend;ππ{ this one divides an integer by and integer, result is shortFixed }ππfunction divfix(d1, d2 : integer) : integer; assembler;πasmπ mov al, byteπ ptr d1 + 1π cbwπ mov dx, axπ xor al, alπ mov ah, byte ptr d1π idiv d2πend;πππ 26 08-27-9321:34ALL DJ MURDOCH Matrix Math IMPORT 33 ₧ {πDJ MURDOCHππ>The solution I use For dynamic Objects (I don't have any Complex code) isπ>to keep a counter in each matrix Record; every Function decrements theπ>counter, and when it reaches 0, disposes of the Object. if you need toπ>use an Object twice, you increment the counter once before using it.ππ> if you allocate an Object twice, how do you get the first address back intoπ> the Pointer Variable so it can be disposed? I must not understand theπ> problem. if I do:ππ> new(p); new(p);ππ> Unless I save the value of the first p, how can I dispose it? And if Iπ> save it, why not use two Pointer Variables, p1 and p2, instead?ππYou're right, there's no way to dispose of the first p^. What I meant isπsomething like this: Suppose X and Y are Pointers to matrix Objects. if Iπwant to calculate Z as their product, and don't have any need For them anyπmore, then it's fine if MatMul disposes of them inππ Z := MatMul(X,Y);ππIn fact, it's Really handy, because it lets me calculate X Y Z asππ W := MatMul(X, MatMul(Y,Z));ππThe problem comes up when I try to calculate something like X^2, because MatMulπwould get in trouble trying to dispose of X twice inππ Y := MatMul(X, X);ππThe solution I use is to keep a counter in every Object, and to follow a rigidπdiscipline:ππ 1. Newly created Objects (Function results) always have the counter set toπ zero.ππ 2. Every Function which takes a Pointer to one of these Objects as anπ argument is sure to "touch" the Pointer, by passing it exactly once toπ another Function. (There's an exception below that lets you pass it moreπ than once if you need to.)ππ3. if a Function doesn't need to pass the Object to another Function, thenπ it passes it to the special Function "Touch()", to satisfy rule 2.π Touch checks the counter; if it's zero, it disposes of the Object,π otherwise, it decrements it by one.ππ4. The way to get around the "exactly once" rule 2 is to call the "Protect"π Function before you pass the Object. This just increments the counter.ππ5. Functions should never change Objects being passed to them as arguments;π there's a Function called "Local" which makes a local copy to work on ifπ you need it. What Local does is to check the counter; if it's zero,π Local just returns the original Object, otherwise it asks the Object toπ make a copy of itself.ππFor example, to do the line above safely, I'd code it asππ Y := MatMul(X, Protect(X));ππMatMul would look something like this:π}ππFunction MatMul(Y, Z : PMatrix) : PMatrix;πVarπ result : PMatrix;πbeginπ { Allocate result, fill in the values appropriately, then }π Touch(Y);π Touch(Z);π MatMul := result;πend;ππ{πThe first Touch would just decrement the counter in X, and the second wouldπdispose of it (assuming it wasn't already protected before the creation of Y).ππI've found that this system works Really well, and I can sleep at night,πknowing that I never leave dangling Pointers even though I'm doing lots ofπallocations and deallocations.ππHere, in Case you're interested, is the Real matrix multiplier:π}ππFunction MProd(x, y : PMatrix) : PMatrix;π{ Calculate the matrix product of x and y }πVarπ result : PMatrix;π i, j, k : Word;π mp : PFloat;πbeginπ if (x = nil) or (y = nil) or (x^.cols <> y^.rows) thenπ MProd := nilπ elseπ beginπ result := Matrix(x^.rows, y^.cols, nil, True);π if result <> nil thenπ With result^ doπ beginπ For i := 1 to rows doπ With x^.r^[i]^ doπ For j := 1 to cols doπ beginπ mp := pval(i,j);π mp^ := 0;π For k := 1 to x^.cols doπ mp^ := mp^ + c[k] * y^.r^[k]^.c[j];π end;π end;π MProd := result;π Touch(x);π Touch(y);π end;πend;ππ{πAs you can see, the memory allocation is a pretty minor part of it. Theπdynamic indexing is Really ugly (I'd like to use "y[k,j]", but I'm stuck usingπ"y^.r^[k]^.c[j]"), but I haven't found any way around that.π}ππ 27 08-27-9321:45ALL MICHAEL BYRNE Prime Numbers IMPORT 7 ₧ {πMICHAEL M. BYRNEππ> the way, it took about 20 mins. on my 386/40 to get prime numbersπ> through 20000. I tried to come up With code to do the same Withπ> Turbo but it continues to elude me. Could anybody explainπ> how to Write such a routine in Pascal?ππHere is a simple Boolean Function For you to work With.π}ππFunction Prime(N : Integer) : Boolean;π{Returns True if N is a prime; otherwise returns False. Precondition: N > 0.}πVarπ I : Integer;πbeginπ if N = 1 thenπ Prime := Falseπ elseπ if N = 2 thenπ Prime := Trueπ elseπ begin { N > 2 }π Prime := True; {tentatively}π For I := 2 to N - 1 doπ if (N mod I = 0) thenπ Prime := False;π end; { N > 2 }πend;π 28 08-27-9321:45ALL JONATHAN WRITE More Prime Numbers IMPORT 9 ₧ {πJONATHAN WRIGHTππHere is source For finding primes. I just pulled this off of an OLD backupπdisk, so I don't Really know how optimized it is, but it works:π}ππConstπ FirstPrime = 2;π MaxPrimes = 16000; (* Limit 64k For one Array, little more work For more *)ππVarπ Primes : Array [1..MaxPrimes] of LongInt;ππ PrimesFound : LongInt;π TestNumber : LongInt;π Count : LongInt;ππ IsPrime : Boolean;ππbeginπ PrimesFound := 1;π TestNumber := FirstPrime + 1;ππ For Count := 1 to MaxPrimes DOπ Primes[Count] := 0;ππ Primes[1] := FirstPrime;ππ Repeatπ Count := 1;π IsPrime := True;ππ Repeatπ if Odd (TestNumber) thenπ if TestNumber MOD Primes[Count] = 0 thenπ IsPrime := False;π INC (Count);π Until (IsPrime = False) or (Count > PrimesFound);ππ if IsPrime = True thenπ beginπ INC (PrimesFound);π Primes[PrimesFound] := TestNumber;π Write (TestNumber, ', ');π end;π INC (TestNumber);π Until PrimesFound = MaxPrimes;πend.π 29 08-27-9321:45ALL GUY MCLOUGHLIN Still More Primes IMPORT 20 ₧ {πGUY MCLOUGHLINππ>the way, it took about 20 mins. on my 386/40 to get prime numbersπ>through 20000. I tried to come up With code to do the same Withπ>Turbo but it continues to elude me. Could anybody explainπ>how to Write such a routine in Pascal?ππ ...The following PRIME routine should prove to be a bit faster:π}ππ{ Find the square-root of a LongInt. }πFunction FindSqrt(lo_IN : LongInt) : LongInt;ππ { SUB : Find square-root For numbers less than 65536. }π Function FS1(wo_IN : Word) : Word;π Varπ wo_Temp1,π wo_Temp2 : Word;π lo_Error : Integer;π beginπ if (wo_IN > 0) thenπ beginπ wo_Temp1 := 1;π wo_Temp2 := wo_IN;π While ((wo_Temp1 shl 1) < wo_Temp2) doπ beginπ wo_Temp1 := wo_Temp1 shl 1;π wo_Temp2 := wo_Temp2 shr 1;π end;π Repeatπ wo_Temp1 := (wo_Temp1 + wo_Temp2) div 2;π wo_Temp2 := wo_IN div wo_Temp1;π lo_Error := (LongInt(wo_Temp1) - wo_Temp2);π Until (lo_Error <= 0);π FS1 := wo_Temp1;π endπ elseπ FS1 := 0;π end;ππ { SUB : Find square-root For numbers greater than 65535. }π Function FS2(lo_IN : longInt) : longInt;π Varπ lo_Temp1,π lo_Temp2,π lo_Error : longInt;π beginπ if (lo_IN > 0) thenπ beginπ lo_Temp1 := 1;π lo_Temp2 := lo_IN;π While ((lo_Temp1 shl 1) < lo_Temp2) doπ beginπ lo_Temp1 := lo_Temp1 shl 1;π lo_Temp2 := lo_Temp2 shr 1;π end;ππ Repeatπ lo_Temp1 := (lo_Temp1 + lo_Temp2) div 2;π lo_Temp2 := lo_IN div lo_Temp1;π lo_Error := (lo_Temp1 - lo_Temp2);π Until (lo_Error <= 0);π FS2 := lo_Temp1;π endπ elseπ FS2 := 0;π end;ππbeginπ if (lo_IN < 65536) thenπ FindSqrt := FS1(lo_IN)π elseπ FindSqrt := FS2(lo_IN);πend;ππ{ Check if a number is prime. }πFunction Prime(lo_IN : LongInt) : Boolean;πVarπ lo_Sqrt,π lo_Loop : LongInt;πbeginπ if not odd(lo_IN) thenπ beginπ Prime := (lo_IN = 2);π Exit;π end;π if (lo_IN mod 3 = 0) thenπ beginπ Prime := (lo_IN = 3);π Exit;π end;π if (lo_IN mod 5 = 0) thenπ beginπ Prime := (lo_IN = 5);π Exit;π end;ππ lo_Sqrt := FindSqrt(lo_IN);π lo_Loop := 7;π While (lo_Loop < lo_Sqrt) doπ beginπ inc(lo_Loop, 2);π if (lo_IN mod lo_Loop = 0) thenπ beginπ Prime := False;π Exit;π end;π end;π Prime := True;πend;π 30 08-27-9321:46ALL JANOS SZAMOSFALVI More Primes Yet !! IMPORT 7 ₧ {πJANOS SZAMOSFALVIππthe following routine uses a brute force approach with someπoptimization; it took less than 3 minutes with a 286/12 to findπand print all primes up to 32768, about 50 seconds w/o printingπthem; it becomes a bit slow when you get into a 6 digit rangeπ}ππPROGRAM Primes;πVARπ number,π max_div,π divisor : INTEGER;π prime : BOOLEAN;πBEGINπ writeln('Primes:');π writeln('2');π FOR number := 2 TO MAXINT DOπ BEGINπ max_div := Round(sqrt(number) + 0.5);π prime := number MOD 2 <> 0;π divisor := 3;π WHILE prime AND (divisor < max_div) DOπ BEGINπ prime := number MOD divisor <> 0;π divisor := divisor + 2;π END;π IF prime THENπ writeln(number);π END;πEND.π 31 08-27-9321:47ALL MARK LEWIS Pythagorean Triples IMPORT 44 ₧ Program PYTHAGOREAN_TRIPLES;π{written by Mark Lewis, April 1, 1990}π{developed and written in Turbo Pascal v3.0}ππConstπ hicnt = 100;π ZERO = 0;ππTypeπ PythagPtr = ^PythagRec; {Pointer to find the Record}π PythagRec = Record {the Record we are storing}π A : Real;π B : Real;π C : Real;π total : Real;π next : PythagPtr {Pointer to next Record in line}π end;ππVarπ Root : PythagPtr; {the starting point}π QUIT : Boolean;π ch : Char;ππProcedure listdispose(Var root : pythagptr);ππVarπ holder : pythagptr;ππbeginπ if root <> nil then {if we have Records in the list}π Repeat {...}π holder := root^.next; {save location of next Record}π dispose(root); {remove this Record}π root := holder; {go to next Record}π Until root = nil; {Until they are all gone}πend;ππProcedure findpythag(Var root : pythagptr);πVarπ x,y,z,stored : Integer;π xy,zz,xx,yy : Real;π abandon : Boolean;π workrec : pythagrec;π last,current : pythagptr;ππbeginπ stored := zero; {init count at ZERO}π For z := 1 to hicnt do {start loop 3}π beginπ zz := sqr(z); {square loop counter}π if zz < zero thenπ zz := 65536.0 + zz; {twiddle For negatives}π For y := 1 to hicnt do {start loop 2}π beginπ yy := sqr(y); {square loop counter}π if yy < zero thenπ yy := 65536.0 + yy; {twiddle For negatives}π For x := 1 to hicnt do {start loop 1}π beginπ abandon := False; {keep this one}π xx := sqr(x); {square loop counter}π xy := xx + yy; {add sqr(loop2) and sqr(loop1)}π if not ((xy <> zz) or ((xy = zz) and (xy = 1.0))) thenπ beginπ With workrec doπ beginπ a := x; {put them into our storage Record}π b := y;π c := z;π total := zz;π end;π if root = nil then {is this the first Record?}π beginπ new(root); {allocate space}π workrec.next := nil; {anchor the Record}π root^ := workrec; {store it}π stored := succ(stored); {how many found?}π endπ else {this is not the first Record}π beginπ current := root; {save where we are now}π Repeat {walk Records looking For dups}π if (current^.total = workrec.total) thenπ abandon := True; {is this one a dup?}{abandon it}π last := current; {save where we are}π current := current^.next {go to next Record}π Until (current = nil) or abandon;π if not abandon then {save this one?}π beginπ {we're going to INSERT this Record into the}π {line between the ones greater than and less}π {than the A Var in the Record}π {ie: 5,12,13 goes between 3,4,5 and 6,8,10}π if root^.a > workrec.a thenπ beginπ new(root); {allocate mem For this one}π workrec.next := last; {point to next rec}π root^ := workrec; {save this one}π stored := succ(stored); {how many found?}π endπ else {insert between last^.next and current}π beginπ new(last^.next); {allocate memory}π workrec.next := current; {point to current}π last^.next^ := workrec; {save this one}π stored := succ(stored); {how many found?}π end;π end;π end;π end;π end;π end;π end;π Writeln('I have found and stored ',stored,' Pythagorean Triples.');πend;ππProcedure showRecord(workrec : pythagrec);ππbeginπ With workrec doπ beginπ Writeln('A = ',a:6:0,' ',sqr(a):6:0);π Writeln('B = ',b:6:0,' ',sqr(b):6:0,' ',sqr(a)+sqr(b):6:0);π Writeln('C = ',c:6:0,' ',sqr(c):6:0,' <-^');π endπend;ππProcedure viewlist(root : pythagptr);ππVarπ i : Integer;π current : pythagptr;ππbeginπ if root = nil thenπ beginπ Writeln('<< Your list is empty! >>');π Write('>> Press (CR) to continue: ');π readln;π endπ elseπ beginπ Writeln('Viewing Records');π current := root;π While current <> nil doπ beginπ showRecord(current^);π Write('Press (CR) to view next Record. . . ');π readln;π current := current^.nextπ end;π endπend;ππbeginπ Writeln('PYTHAGOREAN TRIPLES');π Writeln('-------------------');π Writeln;π Writeln('Remember the formula For a Right Triangle?');π Writeln('A squared + B squared = C squared');π Writeln;π Writeln('I call the set of numbers that fits this formula');π Writeln(' Pythagorean Triples');π Writeln;π Writeln('This Program Uses a "brute force" method of finding all');π Writeln('the Pythagorean Triples between 1 and 100');π Writeln;π root := nil;π quit := False;π Repeatπ Writeln('Command -> [F]ind, [V]iew, [D]ispose, [Q]uit ');π readln(ch);π Case ch ofπ 'q','Q' : quit := True;π 'f','F' : findpythag(root);π 'v','V' : viewlist(root);π 'd','D' : listdispose(root);π end;π Until quit;π if root <> nil thenπ listdispose(root);π Writeln('Normal Program Termination');πend.ππ 32 11-02-9310:31ALL BEN CURTIS Derive PI in Pascal SWAG9311 12 ₧ {πBEN CURTISππHere is a Program that I have written to derive Pi. The formula isπ4 - 4/3 + 4/5 - 4/7 + 4/9... ad infinitum. Unfortunately, I can only getπ14 decimal places using TP 6. if there is a way For me to be able to getπmore than 14 decimal places, please let me know.ππNB: Program Modified by Kerry Sokalsky to increase speed by over 40% -π I'm sure tons more can be done to speed this up even more.π}ππ{$N+}ππUsesπ Dos, Crt;ππVarπ sum : Real;π x, d,π Count : LongInt;π Odd : Boolean;ππbeginπ x := 3;π d := 4;π Sum := 4;π Odd := True;π Count := 0;ππ Writeln(#13#10, 'Iteration Value', #13#10);ππ ClrScr;ππ Repeatπ Inc(Count);π if Odd thenπ Sum := Sum - d/xπ elseπ Sum := Sum + d/x;π Inc(x, 2);ππ Odd := (Not Odd);ππ GotoXY(1, 3);π Write(Count);π GotoXY(12, 3);π Write(Sum : 0 : 7);π Until KeyPressed;ππend.ππ{π I have to warn you, it took me two hours to get a definite answerπfor 6 decimal places on my 486sx25. I guess it would be faster on a dx.πI'll run it on a 486dx2/66 on Tuesday and see if I can get it out to 14πdecimal places. It takes about 135000 iterations to get 4 decimal places.πAgain, please let me know if you know of a way to get more than 14 decimalπplaces -- I would love to get this sucker out to more. :)π}π 33 11-02-9305:07ALL CORY ALBRECHT BASE36 Conversion SWAG9311 16 ₧ { Updated NUMBERS.SWG on November 2, 1993 }ππ{πCORY ALBRECHTππ> Can someone please show me how I would convert a base 10 number toπ> base 36? (The one used by RIP)ππI presume you mean turning a Variable of Type Byte, Word, Integer, orπLongInt to a String representation of that number in base 36? Just checking,πsince once I had someone who had two Word Variables who asked me how theyπcould change Word1 to hexadecimal For putting it in Word2. The followingπcode will turn any number from 0 to 65535 to a String representation ofπthat number in any base from 2 to 36.π}ππUnit Conversion;ππInterfaceππConstπ BaseChars : Array [0..35] Of Char = ('0', '1', '2', '3', '4', '5',π '6', '7', '8', '9', 'A', 'B',π 'C', 'D', 'E', 'F', 'G', 'H',π 'I', 'J', 'K', 'L', 'M', 'N',π 'O', 'P', 'Q', 'R', 'S', 'T',π 'U', 'V', 'W', 'X', 'Y', 'Z');ππ{ n - number to convertπ b - base to convert toπ s - String to store result in }ππProcedure NumToStr(n : Word; b : Byte; Var s);ππImplementationππProcedure NumToStr(n : Word; b : Byte; Var s);πVarπ i,π res,π rem : Word;πbeginπ s := '';π if ((b < 2) or (b > 36)) Thenπ Exit;π res := n;π i := 1;π { Get the digits of number n in base b }π Repeatπ rem = res MOD b;π res := res div b;π s[i] := BaseChars[rem - 1];π Inc(s[0]);π Until rem = 0;π { Reverse s since the digits were stored backwards }π i := 1;π Repeatπ s[i] := Chr(Ord(s[i]) xor Ord(s[Length(s) - (i - 1)]));π s[Length(s) - (i - 1)] := Chr(Ord(s[Length(s) - (i - 1)]) xor Ord(s[i]));π s[i] := Chr(Ord(s[i]) xor Ord(s[Length(s) - (i - 1)]));π Inc(i);π Until i >= (Length(s) - (i - 1));πend;ππend.π 34 11-02-9305:35ALL DEVEN HICKINGBOTHAM Trapping 8087 Errors SWAG9311 32 ₧ {π> I know that in pascal there is some way to create the Programπ> from crashing if the users does something wrong. I need to know how toπTo prevent Type errors on input always use Strings and convert themπafterwards using the VAL Procedure.ππTry this to trap arithmetic errors.π}ππ{$N+,G+}πUnit op8087;ππ{ The routines below duplicate two Op8087 routines For use in TPW, +π Exceptions8087 and Error8087. These routines are helpful when +π doing Real math and you don't want to explicitly check For divide +π by zero, underflow, and overflow. Need to use the compiler +π directives N+ and G+. See OPro or 8087 documentation For a complete +π description of the 8087 status Word returned by Error8087.ππ Do not embed Error8087 in a Write statement as the 8087 status Word +π will be cleared, and the result meaningless.ππ Version 1.00 09/17/92ππ Deven Hickingbotham, Tamarack Associates, 72365,46ππ -----------------------------------------------------------------π Added infinity and NAN 'Constants' and created Unit December 1992π Kevin Whitefoot, Aasgaten 45, N-3060 Svelvik, Norway.ππ After this Unit has initialized 8087 exceptions will be OFF and the NANπ and INF Variables set to NAN and INF respectively. These Variables can beπ used in comparisons or to indicate uninitialized Variables. The Variablesπ are of Type extended but are compatible With singles and doubles too. Youπ cannot assign the value in INF or NAN to a Real because the Real cannotπ represent these values (if you do you will get error 105).π -----------------------------------------------------------------ππ}πππInterfaceππProcedure Exceptions8087(On : Boolean);πFunction Error8087 : Word; {Assumes $G+, 287 or better }ππFunction isdoublenan(r : double) : Boolean;πFunction issinglenan(r : single) : Boolean;ππ{These two Functions are used instead of direct comparisons With NANs asπall numbers are = to NAN; very strange}ππConstπ nanpattern : Array [0..9] of Byte =π ($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);π { This is the bit pattern of an extended 'not a number'. The +π Variable NAN is overlaid on this as we cannot create a NAN in a +π normal Constant declaration.}πVarπ nan : extended Absolute nanpattern;π { not a number'; this is convenient For uninitialized numbers, +π errors and so on, parsers can be designed to return this when +π the input is not a number so that the error remains visible even +π if the user or Program takes no corrective action}π inf : extended;π { The initialization of this routine deliberately executes a +π divide by zero so as to create and infinity and stores it here +π For general use.}ππ singlenan : single;π doublenan : double;ππImplementationππFunction isdoublenan(r : double) : Boolean;πVarπ l1 : Array [0..1] of LongInt Absolute singlenan;π l2 : Array [0..1] of LongInt Absolute r;πbeginπ isdoublenan := (l1[0] = l2[0]) and (l1[1] = l2[1]);πend;ππFunction issinglenan(r : single) : Boolean;πVarπ l1 : LongInt Absolute singlenan;π l2 : LongInt Absolute r;πbeginπ issinglenan := l1 = l2;πend;ππProcedure Exceptions8087(On : Boolean); Assembler;πVarπ CtrlWord : Word;πAsmπ MOV AL, Onπ or AL, ALπ JZ @ExceptionsOffππ MOV CtrlWord, 0372H { Unmask IM, ZM, OM }π JMP #ExceptionsDoneππ @ExceptionsOff:π FSTCW CtrlWord { Get current control Word }π or CtrlWord, 00FFh { Mask all exceptions }ππ @ExceptionsDone:π FLDCW CtrlWord { Change 8087 control Word }πend;πππFunction Error8087 : Word; Assembler; {Assumes $G+, 287 or better }πAsmπ FSTSW AX { Get current status Word }π and AX, 03Fh { Just the exception indicators }π FCLEX { Clear exception indicators }πend;ππbeginπ Exceptions8087(False);π inf := 0; { Use a Variable not a Constant or the expression will beπ resolved at compile time and the compiler will complain }π inf := 1 / inf;π singlenan := nan;π doublenan := nan;πend.π 35 11-02-9306:22ALL GERD KORTEMEYER Getting a Square Root SWAG9311 7 ₧ {πkortemey@rudolf.nscl.msu.edu (Gerd Kortemeyer)ππ>Does anyone have a Turbo Pascal 6.0/7.0 Function that will return theπ>square root of a regular 6 Byte Real argument. I need a faster one thanπ>the one the comes With TP7.0 because my Program is spending a lot of timeπ>in it.ππif you Really need to do fast FP-calculations you should use a coprocessorπ(or a 486DX) together With its dataTypes SINGLE, DOUBLE and EXTendED.ππif you already got a copro and still use Real, that's the worst thing youπcan do. In fact using Real With copro is often slower than Without becauseπthe 6 Byte Real always has to be converted into a copro dataType.ππNow here is what you can Write instead of x:=sqrt(a);π}πAsmπ fld aπ fsqrtπ fstp xπend;πππ 36 11-21-9309:37ALL GREG VIGNEAULT 32Bit unsigned integers SWAG9311 49 ₧ {πFrom: GREG VIGNEAULTπSubj: 32-bit unsigned integersπDoes there exist a 32 BIT unsigned (0..xxxx) word in pascal ??πi've got a hexidecimal string (ex. 'E72FAB32') .. now i want toπconvert this to a decimal value (not below 0 such as longint andπextended do) so i can devide this by for example 5000000πππ (Note: check at END of code for the required ULONGS.OBJ file)π}ππ(*******************************************************************)πPROGRAM Longs; { compiler: Turbo Pascal v4.0+ }π { 18-Nov-93 Greg Vigneault }π{ Purpose: arithmetic functions for unsigned long integers in TP... }π(*-----------------------------------------------------------------*)π{ The following external (assembly) functions *MUST* be linked into }π{ the main Program, _not_ a Unit. }ππ{$L ULONGS.OBJ} { link in the assembly code }πFUNCTION LongADD (Addend1,Addend2:LONGINT):LONGINT; EXTERNAL;πFUNCTION LongSUB (LongWord,Subtrahend:LONGINT):LONGINT; EXTERNAL;πFUNCTION LongMUL (Multiplicand,Multiplier:LONGINT):LONGINT; EXTERNAL;πFUNCTION LongDIV (Dividend,Divisor:LONGINT):LONGINT; EXTERNAL;πFUNCTION LongMOD (Dividend,Divisor:LONGINT):LONGINT; EXTERNAL;πPROCEDURE WriteULong (LongWord:LONGINT; { the longword }π Width:BYTE; { _minimum_ field width }π FillChar:CHAR; { leading space char }π Base:BYTE); EXTERNAL; { number base 2..26 }π(*-----------------------------------------------------------------*)πPROCEDURE TestLongs ( Long1,Long2 :LONGINT;π Width :BYTE;π Fill :CHAR;π Base :BYTE);π PROCEDURE Reduce1;π BEGINπ WriteULong (Long1,1,Fill,10); Write (',');π WriteULong (Long2,1,Fill,10); Write (') result: ');π END {Reduce1};π PROCEDURE Reduce2;π BEGINπ CASE Base OFπ 2 : WriteLn (' binary'); { base 2: binary }π 10 : WriteLn (' dec'); { base 10: familiar decimal }π 16 : WriteLn (' hex'); { base 16: hexadecimal }π END;π END {Reduce2};π BEGIN {TestLongs}π Write ('LongADD ('); Reduce1;π WriteULong ( LongADD(Long1,Long2),Width,Fill,Base ); Reduce2;π Write ('LongSUB ('); Reduce1;π WriteULong ( LongSUB(Long1,Long2),Width,Fill,Base ); Reduce2;π Write ('LongMUL ('); Reduce1;π WriteULong ( LongMUL(Long1,Long2),Width,Fill,Base ); Reduce2;π Write ('LongDIV ('); Reduce1;π WriteULong ( LongDIV(Long1,Long2),Width,Fill,Base ); Reduce2;π Write ('LongMOD ('); Reduce1;π WriteULong ( LongMOD(Long1,Long2),Width,Fill,Base ); Reduce2;π WriteLn;π END {TestLongs};π(*-----------------------------------------------------------------*)ππVAR Long1, Long2 :LONGINT;π Width, Base :BYTE;ππBEGINππ Long1 := 2147483647;π Long2 := 1073741823;π Width := 32;ππ WriteLn;π FOR Base := 2 TO 16 DOπ IF Base IN [2,10,16] THENπ TestLongs (Long1,Long2,Width,'_',Base);ππEND.ππ---------------------------------------------------------------------------ππ Run this program, it will create ULONGS.ZIP, which contains theπ ULONGS.OBJ file needed for the LongXXX functions...ππ(*********************************************************************)π PROGRAM A; VAR G:File; CONST V:ARRAY [ 1..701 ] OF BYTE =(π80,75,3,4,20,0,0,0,8,0,236,50,114,27,51,246,185,93,71,2,0,0,189,3,0,0,π10,0,0,0,85,76,79,78,71,83,46,79,66,74,189,83,77,104,19,65,20,126,179,π187,217,196,53,104,67,176,162,1,181,135,10,118,80,212,158,36,151,166,π110,215,22,154,4,76,119,133,66,75,241,160,23,169,146,102,123,14,132,80,π233,92,4,65,132,122,8,197,91,142,198,155,212,52,238,138,181,136,157,205,π65,75,15,5,91,145,18,255,64,76,80,138,248,54,19,17,4,193,147,11,111,190,π247,190,247,189,111,222,30,38,31,6,205,190,118,125,250,234,204,169,68,π38,249,228,78,24,64,209,19,99,9,229,124,90,31,234,185,27,132,169,19,32,π73,164,142,217,192,126,73,150,201,158,91,195,0,82,112,52,157,186,144,π208,245,9,128,118,154,76,235,5,34,82,125,196,250,218,97,51,230,224,141,π95,2,115,116,1,64,187,116,113,100,108,200,244,9,0,168,220,84,0,22,9,47,π157,4,2,255,254,157,45,69,37,9,192,100,239,153,161,244,109,23,171,185,π36,251,204,12,141,89,225,254,21,246,154,213,250,189,86,243,118,171,57,π87,207,36,138,85,251,67,209,179,119,152,17,234,219,142,47,207,70,216,π58,93,102,207,42,210,188,165,190,232,121,211,98,171,21,105,60,255,252,π116,254,251,185,89,57,95,11,34,247,113,162,166,117,204,153,165,202,70,π40,106,105,19,181,144,160,52,106,168,217,195,118,8,253,168,161,100,187,π16,153,133,164,18,179,84,95,68,171,212,107,52,81,186,251,24,128,122,216,π46,239,93,195,49,60,115,91,180,90,46,211,13,186,66,189,167,42,192,49,π62,173,242,73,101,166,75,198,34,122,4,99,31,70,55,0,63,142,209,253,59,π126,32,111,123,172,222,89,2,141,119,255,112,190,239,59,35,143,43,151,π153,161,150,253,114,105,192,95,166,125,27,118,120,47,55,37,110,42,220,π84,249,26,175,115,206,189,56,90,103,207,196,209,60,75,227,120,125,182,π55,142,139,100,143,82,60,99,88,199,176,19,67,77,33,64,10,166,4,5,83,193,π80,33,101,63,96,1,102,74,127,221,198,150,119,240,215,255,235,66,254,46,π218,189,6,56,37,32,132,128,179,164,16,226,172,138,252,37,130,12,78,29,π33,0,206,43,132,32,56,27,162,183,41,122,91,162,247,78,244,26,254,240,π55,204,15,129,27,65,136,128,75,69,53,136,112,16,220,97,132,3,224,166,π16,162,224,142,9,201,184,128,73,65,94,22,146,43,98,96,174,61,94,92,192,π135,164,17,119,81,40,31,9,207,186,144,172,139,129,77,49,254,86,72,26,π2,62,9,242,139,144,180,218,3,15,231,241,5,228,126,2,80,75,1,2,20,0,20,π0,0,0,8,0,236,50,114,27,51,246,185,93,71,2,0,0,189,3,0,0,10,0,0,0,0,0,π0,0,0,0,32,0,0,0,0,0,0,0,85,76,79,78,71,83,46,79,66,74,80,75,5,6,0,0,π0,0,1,0,1,0,56,0,0,0,111,2,0,0,0,0π); BEGIN Assign(G,'ULONGS.ZIP'); Rewrite(G,SizeOf(V));π BlockWrite(G,V,1); Close(G); END {Gbug1.5b}.π(*********************************************************************)π 37 11-02-9305:08ALL JOHN GUILLORY Change Number Base SWAG9311 6 ₧ { Updated NUMBERS.SWG on November 2, 1993 }ππ{πJOHN GUILLORYππ> Can someone please show me how I would convert a base 10 number to base 36?π}ππFunction BaseChange(Num, NewBase : Word) : String;πConstπ BaseChars : Array [0..36] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';πVarπ St : String;πbeginπ St := '';π Repeatπ St := BaseChars[Num MOD NewBase] + St;π Num := Num Div NewBase;π Until Num = 0;π BaseChange := St;πend;ππ{πThis will convert a number in Base10 (Stored in Orig) to any Base in theπrange of 2 through 36 (Please, no base-1's/0's)π}ππbeginπ Writeln(Basechange(33, 3));πend.π 38 11-26-9317:05ALL LARS FOSDAL Nice Expression Parser SWAG9311 41 ₧ PROGRAM Expr;ππ{π Simple recursive expression parser based on the TCALC example of TP3.π Written by Lars Fosdal 1987π Released to the public domain 1993π}ππPROCEDURE Eval(Formula : String; { Expression to be evaluated}π VAR Value : Real; { Return value }π VAR ErrPos : Integer); { error position }π CONSTπ Digit: Set of Char = ['0'..'9'];π VARπ Posn : Integer; { Current position in Formula}π CurrChar : Char; { character at Posn in Formula }πππPROCEDURE ParseNext; { returnerer neste tegn i Formulaen }πBEGINπ REPEATπ Posn:=Posn+1;π IF Posn<=Length(Formula) THEN CurrChar:=Formula[Posn]π ELSE CurrChar:=^M;π UNTIL CurrChar<>' ';πEND { ParseNext };πππFUNCTION add_subt: Real;π VARπ E : Real;π Opr : Char;ππ FUNCTION mult_DIV: Real;π VARπ S : Real;π Opr : Char;ππ FUNCTION Power: Real;π VARπ T : Real;ππ FUNCTION SignedOp: Real;ππ FUNCTION UnsignedOp: Real;π TYPEπ StdFunc = (fabs, fsqrt, fsqr, fsin, fcos,π farctan, fln, flog, fexp, ffact);π StdFuncList = ARRAY[StdFunc] of String[6];ππ CONSTπ StdFuncName: StdFuncList =π ('ABS','SQRT','SQR','SIN','COS',π 'ARCTAN','LN','LOG','EXP','FACT');π VARπ E, L, Start : Integer;π Funnet : Boolean;π F : Real;π Sf : StdFunc;ππ FUNCTION Fact(I: Integer): Real;π BEGINπ IF I > 0 THEN BEGIN Fact:=I*Fact(I-1); ENDπ ELSE Fact:=1;π END { Fact };ππ BEGIN { FUNCTION UnsignedOp }π IF CurrChar in Digit THENπ BEGINπ Start:=Posn;π REPEAT ParseNext UNTIL not (CurrChar in Digit);π IF CurrChar='.' THEN REPEAT ParseNext UNTIL not (CurrChar in Digit);π IF CurrChar='E' THENπ BEGINπ ParseNext;π REPEAT ParseNext UNTIL not (CurrChar in Digit);π END;π Val(Copy(Formula,Start,Posn-Start),F,ErrPos);π END ELSEπ IF CurrChar='(' THENπ BEGINπ ParseNext;π F:=add_subt;π IF CurrChar=')' THEN ParseNext ELSE ErrPos:=Posn;π END ELSEπ BEGINπ Funnet:=False;π FOR sf:=fabs TO ffact DOπ IF not Funnet THENπ BEGINπ l:=Length(StdFuncName[sf]);π IF Copy(Formula,Posn,l)=StdFuncName[sf] THENπ BEGINπ Posn:=Posn+l-1; ParseNext;π f:=UnsignedOp;π CASE sf ofπ fabs: f:=abs(f);π fsqrt: f:=SqrT(f);π fsqr: f:=Sqr(f);π fsin: f:=Sin(f);π fcos: f:=Cos(f);π farctan: f:=ArcTan(f);π fln : f:=LN(f);π flog: f:=LN(f)/LN(10);π fexp: f:=EXP(f);π ffact: f:=fact(Trunc(f));π END;π Funnet:=True;π END;π END;π IF not Funnet THENπ BEGINπ ErrPos:=Posn;π f:=0;π END;π END;π UnsignedOp:=F;π END { UnsignedOp};ππ BEGIN { SignedOp }π IF CurrChar='-' THENπ BEGINπ ParseNext; SignedOp:=-UnsignedOp;π END ELSE SignedOp:=UnsignedOp;π END { SignedOp };ππ BEGIN { Power }π T:=SignedOp;π WHILE CurrChar='^' DOπ BEGINπ ParseNext;π IF t<>0 THEN t:=EXP(LN(abs(t))*SignedOp) ELSE t:=0;π END;π Power:=t;π END { Power };πππ BEGIN { mult_DIV }π s:=Power;π WHILE CurrChar in ['*','/'] DOπ BEGINπ Opr:=CurrChar; ParseNext;π CASE Opr ofπ '*': s:=s*Power;π '/': s:=s/Power;π END;π END;π mult_DIV:=s;π END { mult_DIV };ππ BEGIN { add_subt }π E:=mult_DIV;π WHILE CurrChar in ['+','-'] DOπ BEGINπ Opr:=CurrChar; ParseNext;π CASE Opr ofπ '+': e:=e+mult_DIV;π '-': e:=e-mult_DIV;π END;π END;π add_subt:=E;π END { add_subt };ππBEGIN {PROC Eval}π IF Formula[1]='.'π THEN Formula:='0'+Formula;π IF Formula[1]='+'π THEN Delete(Formula,1,1);π FOR Posn:=1 TO Length(Formula)π DO Formula[Posn] := Upcase(Formula[Posn]);π Posn:=0;π ParseNext;π Value:=add_subt;π IF CurrChar=^M THEN ErrPos:=0 ELSE ErrPos:=Posn;πEND {PROC Eval};ππVARπ Formula : String;π Value : Real;π i, Err : Integer;πBEGINπ REPEATπ Writeln;π Write('Enter formula (empty exits): '); Readln(Formula);π IF Formula='' THEN Exit;π Eval(Formula, Value, Err);π Write(Formula);π IF Err=0π THEN Writeln(' = ',Value:0:5)π ELSE BEGINπ Writeln;π FOR i:=1 TO Err-1 DO Write(' ');π Writeln('^-- Error in formula');π END;π UNTIL False;πEND.ππ 39 11-02-9316:08ALL LOU DUCHEZ BASE of a Number SWAG9311 36 ₧ { Three ways to find the BASE of a number }πππfunction base2l(strin: string; base: byte): longint;ππ{ converts a string containing a "number" in another base into a decimalπ longint }ππvar cnter, len: byte;π dummylint: longint;π seendigit, negatize: boolean;π begalpha, endalpha, thschr: char;πbeginπ dummylint := 0;π begalpha := char(65);π endalpha := char(64 + base - 10);π negatize := false;π seendigit := false;π len := length(strin);π cnter := 1;ππ { the following loop processes each character }ππ while cnter <= len do beginπ thschr := upcase(strin[cnter]);π case thschr ofπ '-': if seendigit then cnter := len else negatize := true;ππ { if we haven't seen any "digits" yet, it'll be a negativeπ number; otherwise the hyphen is an extraneous character soπ we're done processing the string }ππ '0' .. '9': if byte(thschr) - 48 < base then beginπ dummylint := base*dummylint + byte(thschr) - 48;π seendigit := true;π endπ else cnter := len;ππ { 0-9: if the base supports the digit, use it; otherwise,π it's an extraneous character and we're done }ππ ' ': if seendigit then cnter := len;ππ { space: if we've already encountered some digits, we're done }ππ else beginππ { all other characters }ππ if (thschr >= begalpha) and (thschr <= endalpha) thenππ { an acceptable character for this base }ππ dummylint := base*dummylint + byte(thschr) - 65 + 10π elseππ { not acceptabe: we're done }ππ cnter := len;π end;π end;π cnter := cnter + 1;π end;π if negatize then dummylint := -dummylint;π base2l := dummylint;π end;ππ{Another way:}ππfunction l2base(numin: longint; base, numplaces: byte; leadzero: boolean): string;ππ{ Converts a longint into a string representing the number in another base.π Numin = the longint; base = base; numplaces is how many characters the answerπ should go in; leadzero indicates whether to put leading zeros. }ππvar tmpstr: string;π remainder, cnter, len: byte;π negatize: boolean;πbeginπ negatize := (numin < 0);π if negatize then numin := abs(numin);ππ { assign number of places in string }ππ tmpstr[0] := char(numplaces);π len := numplaces;ππ { now fill those places from right to left }ππ while numplaces > 0 do beginπ remainder := numin mod base;π if remainder > 9 thenπ tmpstr[numplaces] := char(remainder + 64 - 9)π elseπ tmpstr[numplaces] := char(remainder + 48);π numin := numin div base;π numplaces := numplaces - 1;π end;ππ { not enough room assigned: fill with asterisks }ππ if (numin <> 0) or (negatize and (tmpstr[1] <> '0')) thenπ for numplaces := 1 to byte(tmpstr[0]) do tmpstr[numplaces] := '*';ππ { put in minus sign }ππ if leadzero then beginπ if negatize and (tmpstr[1] = '0') then tmpstr[1] := '-'π endπ else beginπ cnter := 1;π while (cnter < len) and (tmpstr[cnter] = '0') do beginπ tmpstr[cnter] := ' ';π cnter := cnter + 1;π end;π if negatize and (cnter > 1) then tmpstr[cnter - 1] := '-';π end;π l2base := tmpstr;π end;ππ{ Yet another way }ππProgram ConvertBase;ππProcedure UNTESTEDConvertBase(BaseN:Byte; BaseNNumber:String;π BaseZ:Byte; var BaseZNumber:String);ππvarπ I: Integer;π Number,Remainder: LongInt;ππbeginπ Number := 0;π for I := 1 to Length (BaseNNumber) doπ case BaseNNumber[I] ofπ '0'..'9': Number := Number * BaseN + Ord (BasenNumber[I]) - Ord ('0');π 'A'..'Z': Number := Number * BaseN + Ord (BasenNumber[I]) -π Ord ('A') + 10;π 'a'..'z': Number := Number * BaseN + Ord (BasenNumber[I]) -π Ord ('a') + 10;π end; BaseZNumber := ''; while Number > 0 doπ beginπ Remainder := Number mod BaseZ;π Number := Number div BaseZ;π case Remainder ofπ 0..9: BaseZNumber := Char (Remainder + Ord ('0')) + BaseZNumber;π 10..36: BaseZNumber := Char (Remainder - 10 + Ord ('A')) + BaseZNumber;π end;ππend; end;πππvar BaseN,BaseZ:Byte;π BaseNNumber,π BaseZNumber:String;ππBeginππ Write(' BASE N > ');π Readln(BaseN);π Write(' NUMBER N> ');π Readln(BaseNNumber);π Write(' BASE Z > ');π Readln(BaseZ);π Write(' NUMBER Z> ');π UntestedConvertBase(BaseN,BaseNNumber,BaseZ,BaseZNumber);π Writeln(BaseZNumber);π Readln;πend.π 40 11-02-9305:05ALL LOU DUCHEZ CALCULUS SWAG9311 41 ₧ { Updated NUMBERS.SWG on November 2, 1993 }ππ{πLOU DUCHEZππHey everybody! This unit performs calculus operations via basic numericalπmethods : integrals, derivatives, and extrema. By Lou DuChez. I don'tπwant any money for this; please just leave my name in the source codeπsomewhere, since this is the closest I'll ever get to being famous.ππAll functions return real values. The last parameter in each function isπa pointer to a "real" function that takes a single "real" parameter:πfor example, y(x). See prior message to Timothy C. Novak for sample prog }ππunit calculus;πinterfaceππfunction integral(a, b, h : real; f : pointer) : real;πfunction derivative(x, dx : real; f : pointer) : real;πfunction extremum(x, dx, tolerance : real; f : pointer) : real;ππimplementationππtypeπ fofx = function(x : real) : real; { needed for function-evaluating }ππfunction integral(a, b, h : real; f : pointer) : real;πvarπ x, summation : real;π y : fofx;πbegin { Integrates function from a to b, }π @y := f; { by approximating function with }π summation := 0; { rectangles of width h. }π x := a + h/2;π while x < b doπ begin { Answer is sum of rectangle areas, }π summation := summation + h*y(x); { each area being h*y(x). X is at }π x := x + h; { the middle of the rectangle. }π end;π integral := summation;πend;ππfunction derivative(x, dx : real; f : pointer) : real;πvarπ y : fofx;πbegin { Derivative of function at x: delta y over delta x }π @y := f; { You supply x & delta x }π derivative := (y(x + dx/2) - y(x - dx/2)) / dx;πend;πππfunction extremum(x, dx, tolerance : real; f : pointer) : real;π{ This function uses DuChez's Method for finding extrema of a function (yes,π I seem to have invented it): taking three points, finding the parabolaπ that connects them, and hoping that an extremum of the function is nearπ the vertex of the parabola. If not, at least you have a new "x" to try...ππ X is the initial value to go extremum-hunting at; dx is how far on eitherπ side of x to look. "Tolerance" is a parameter: if two consecutiveπ iterations provide x-values within "tolerance" of each other, the answerπ is the average of the two. }πvarπ y : fofx;π gotanswer,π increasing,π decreasing : boolean;π oldx : real;π itercnt : word;πbeginπ @y := f;π gotanswer := false;π increasing := false;π decreasing := false;π itercnt := 1;π repeat { repeat until you have answer }π oldx := x;π x := oldx - dx*(y(x+dx) - y(x-dx)) / { this monster is the new value }π (2*(y(x+dx) - 2*y(x) + y(x-dx))); { of "x" based DuChez's Method }π if abs(x - oldx) <= tolerance thenπ gotanswer := true { within tolerance: got an answer }π elseπ if (x > oldx) thenπ beginπ if decreasing thenπ begin { If "x" is increasing but it }π decreasing := false; { had been decreasing, we're }π dx := dx/2; { oscillating around the answer. }π end; { Cut "dx" in half to home in on }π increasing := true; { the extremum. }π endπ elseπ if (x < oldx) thenπ beginπ if increasing thenπ begin { same thing here, except "x" }π increasing := false; { is now decreasing but had }π dx := dx/2; { been increasing }π end;π decreasing := true;π end;π until gotanswer;ππ extremum := (x + oldx) / 2; { spit out answer }πend;ππend.ππππ{πI've put together a unit that does calculus. This unit could be used, forπexample, to approximate the area under a curve (like a circle).ππBecause of the funny way my offline reader breaks up messages, I'm goingπto send you a "test" program first -- which just happens to calculateπthe area under a quarter circle -- then the following message (I hope)πwill be the unit source code.π}ππprogram mathtest;πusesπ calculus;ππvarπ answer : real;ππ{$F+} { WARNING! YOU NEED "FAR" FUNCTIONS! }πfunction y(x : real) : real;πbeginπ y := 4 * sqrt(1 - x * x);πend;ππbeginπ writeln('Function: y = (1 - x^2)^(1/2) (i.e., top half of a circle)');π writeln;ππ{ Calc operations here are: }ππ{ Integrate function from 0 to 1, in increments of 0.001. A quarter circle. }π{ Get slope of function at 0 by evaluating points 0.01 away from each other. }π{ Find extremum of function, starting at 0.4, initially looking at pointsπ 0.1 on either side of 0.4, and not stopping until we have two x-valuesπ within 0.001 of each other. }ππ answer := integral(0, 1, 0.001, @y);π writeln('Integ: ', answer:13:9);ππ answer := derivative (0, 0.01, @y);π writeln('Deriv: ', answer:13:9);ππ answer := extremum(0.4, 0.1, 0.001, @y);π writeln('Extrm: ', answer:13:9);πend.ππ 41 11-02-9310:31ALL LOU DUCHEZ Calculate PI SWAG9311 18 ₧ {πLOU DUCHEZππATTENTION, whoever was trying to calculate PI! Here's a swell program,πas a follow-up to a recent post of mine about approximating techniques!ππ}ππprogram calcpi; { Calculates pi by getting the area of one-quarter of aπ circle of radius 1, and then multiplying by 4. The areaπ is an approximation, derived by Simpson's method: seeπ previous post for explanation of that technique. }ππusesπ crt;ππconstπ lowerbound = 0; { The interval we're evaluating is from 0 to 1. }π higherbound = 1; { I put the 0 and 1 here for clarity. }ππvarπ incs : word;π quartpi,π h, x : real;ππfunction y(x : real) : real; { Feed it an x-value, and it tells you the }πbegin { corresponding y-value on the unit circle. }π y := sqrt(1 - x * x); { A no-brainer. }πend;ππbeginπ { I leave you to do the error-checking on input. }π clrscr;π write('Enter a WORD (1 - 32767) for the number of parabolas to do: ');π readln(incs);ππ { The answer for a quarter of pi will be accumulated into QuartPi. }π quartpi := 0;ππ { H is the interval to increment on. X is the "middle" x value for eachπ parabola in Simpson's method. Here it is set equal to one intervalπ above the lower bound: Simpson's method looks at points on either sideπ of "X", so my reasoning is obvious. Note also that, by magicalπ coincidence, the last evaluation will have "X" equal to the higherπ bound of the interval minus H. }ππ h := (higherbound - lowerbound) / (1 + 2 * incs);π x := lowerbound + h;ππ { This loop accumulates a value for pi/4. }π while incs > 0 doπ beginπ if x < 0 thenπ x := 0;π quartpi := quartpi + y(x - h) + 4 * y(x) + y(x + h);ππ { Move X two increments to the right, and decrease the number of parabolasπ we still have to do. }π x := x + 2 * h;π dec(incs);π end;ππ { Simpson's method has you multiply the sum by H/3. }π quartpi := h * quartpi / 3;ππ { Print answer. }π writeln(4 * quartpi : 12 : 8);π writeln('This has been a display of Simpson''s method. D''ohh!');πend.π 42 11-02-9306:31ALL LOU DUCHEZ Compute Angles SWAG9311 18 ₧ {πLOU DUCHEZππ>I'm looking for the way turbo pascal computes the angle.π>Now how can I compute for the Angles C & B.ππ> b, c, a, B_angle, C_angle: real;ππ> ┌─┐B angleπ> │ └─────┐ aπ> b│ └─────┐π> │ └─────┐π> │A = 90 └─────┐π> └─────────────────────────┘ C angleπ> cππOkay, you've got b and c. There is an ArcTan function that returnsπan angle in radians. Try this:π}ππ b := abs(b); { these lines keep the operator from getting "cute" }π c := abs(c);π if c <> 0 thenπ begin { prevents "division by zero" thing }π C_angle := arctan(b/c);π B_angle := (pi/2) - C_angle; { 90 degrees minus the one angle }π endπ elseπ if b <> 0 thenπ begin { ditto }π B_angle := arctan(c/b);π C_angle := (pi/2) - B_angle;π endπ elseπ begin { you'll get here only if b = c = 0 }π B_angle := 0;π C_angle := 0;π writeln('That''s a dot, not a triangle!');π end;π{πMight I recommend that you have the user do data entry in a "repeat" loop,πso that he can get out only when he's put in actual positive values? Iπthink you'll discover that a little caution at data-entry time is worth itπin spared headaches later. (Note all the error-checking I had to do ...)ππOh, you wanted degrees, minutes, seconds. I don't know of any built-inπroutines for this (I admit I may have missed something), but here's someπtotally untested code to convert radians to degrees, minutes, seconds:π}πprocedure r2dms(rad : real; var deg, min, sec : real);πbeginπ deg := rad * 180 / pi; { conversion to degrees }π min := frac(deg) * 60; { convert remainder to minutes }π deg := trunc(deg); { lose the remainder on degrees }π sec := frac(min) * 60; { convert "minutes" remainder to seconds }π min := trunc(min); { lose the remainder on minutes }πend;ππ{ Here's the reverse journey: }ππprocedure dms2r(deg, min, sec : real; var rad : real);πbeginπ rad := pi * (deg + 60 * min + 3600 * sec) / 180;πend;π 43 11-02-9310:30ALL LOU DUCHEZ Pascal Triangle SWAG9311 14 ₧ {πLOU DUCHEZππ>Also, does anyone have anycode to do Pascal's Triangle?ππThe pattern is:ππ 1 1π 1 2 1π 1 3 3 1π 1 4 6 4 1ππwhere each element = the sum of the two above it.ππArrange it like this:ππ0110 -- The zeros are needed so that the algorithm can process the 1's.π01210π013310π0146410ππI'd have two Arrays: one shows the last row's figures, and the other holdsπthe current row's figures. Each "new" element (call the index "i") = theπsum of "previous" element "i" + "previous" element "i - 1".π}ππProcedure CalcPascalRow(r : Word); { which row to calculate }ππVarπ prows : Array[0..1, 0..100] of Word;{ your two Arrays }π thisrow,π lastrow : Byte; { point to this row & last row }π i, j : Word; { counters }ππbeginπ lastrow := 0; { set up "which row is which" }π thisrow := 1;π prows[lastrow, 0] := 0; { set up row "1": 0110 }π prows[lastrow, 1] := 1;π prows[lastrow, 2] := 1;π prows[lastrow, 3] := 0;π For j := 2 to r doπ begin { generate each "line" starting w/2 }π prows[thisrow, 0] := 0;π For i := 1 to j + 1 doπ begin { each "new" element = sum of "old" }π prows[thisrow, i] := { element + predecessor to "old" }π prows[lastrow, i] + { element }π prows[lastrow, i - 1];π end;π prows[thisrow, j + 2] := 0;π lastrow := thisrow; { prepare For next iteration }π thisrow := (thisrow + 1) mod 2;π end;π For i := 1 to r + 1 doπ { Write each element of desired line }π Write(prows[lastrow, i] : 4);π Writeln;πend;π 44 11-02-9306:28ALL LOU DUCHEZ Test of CALCULUS Unit SWAG9311 9 ₧ { LOU DUCHEZ }πprogram mathtest;πusesπ calculus;ππvarπ answer : real;ππ{$F+} { WARNING! YOU NEED "FAR" FUNCTIONS! }πfunction y(x : real) : real;πbeginπ y := 2 * sqrt(4 - x * x);πend;π{$F-}ππbeginπ Writeln;π Writeln('Function: y = 2 * (4 - x^2)^(1/2) (i.e., Circle Radius 2)');π Writeln;ππ{ Calc operations here are: }ππ{ Integrate function from -2 to 2, in increments of 0.001. A half circle. }π{ However since equation multiplies it by 2, then we get area of full circle }π{ Get slope of function at 0 by evaluating points 0.01 away from each other. }π{ Find extremum of function, starting at 0.4, initially looking at pointsπ 0.1 on either side of 0.4, and not stopping until we have two x-valuesπ within 0.001 of each other. }ππ answer := integral(-2, 2, 0.001, @y); writeln('Integ: ', answer:13:9);π answer := derivative(1, 0.001, @y); writeln('Deriv: ', answer:13:9);π answer := extremum(0.4, 0.1, 0.001, @y); writeln('Extrm: ', answer:13:9);π Writeln(4*Pi:0:6);πend.π 45 11-02-9305:27ALL ROBERT ROTHENBURG Complex Math SWAG9311 5 ₧ {πROBERT ROTHENBURGππ> Can you compute complex numbers and/or "i" in Pascal...if so, how.ππNot too hard. I've done that With some fractal Programs, which wereπwritten For TP5 (it might be easier using OOP With the later versions).ππI use two Variables For a complex number of a+bi, usually expressed asπxa and xb (or x.a and x.b as a Record).ππFor addition/subtraction (complex z=x+y):ππ z.a:=x.a+y.a;π z.b:=x.b+y.b;ππFor multiplication:ππ z.a:=(x.a*y.a)-(x.b*y.b);π z.b:=(x.a*y.b)+(x.b*y.a);π}π 46 09-26-9310:15ALL RYAN THOMPSON Math Parsing Unit SWAG9311 32 ₧ (*πFrom: RYAN THOMPSONπSubj: RE: MATH PARSINGπ*)ππFunction Evaluate(Equation : String) : String;π Varπ Temp, Operand, Front, Rear : String;π X, Y, Par1, Par2 : Integer;π Value1, Value2, Valtemp : Real;π OperOK,π BadExp : Boolean;π Beginπ If Equation = Error then beginπ Evaluate:= Error;π Exit;π end;π While Pos(' ', Equation) > 0 doπ Delete(Equation, Pos(' ', Equation), 1);π repeatπ X:= 1;π Par1:= 0;π Par2:= 0;π repeatπ If Equation[X] = '(' then Par1:= X;π If Equation[X] = ')' then Par2:= X;π Inc(X);π until (X = Length(Equation) + 1) or ((Par1 > 0) and (Par2 > 0));π If (Par2 > 0) and (Par2+1 < Length(Equation)) andπ (Equation[Par2 + 1] = '(')π then Insert('x', Equation, Par2 + 1);π If (Par2 > Par1) then beginπ Temp:= Equation;π Rear:= Copy(Temp, Par2 + 1, 255);π Delete(Temp, Par2, 255);π Front:= Copy(Temp, 1, Par1 - 1);π Delete(Temp, 1, Par1);π Temp:= Evaluate(Temp);π Equation:= Front + Temp + Rear;π While Pos(' ', Equation) > 0 doπ Delete(Equation, Pos(' ', Equation), 1);π endπ else if Par2 < Par1 then beginπ Evaluate:= Error;π Exit;π end;π until Par2 <= Par1;π Value1:= 0;π repeatπ If (Length(Equation) > 0) then beginπ Operand:= '';π X:= 1;π While ((Equation[X] < '0') or (Equation[X] > '9'))π and (Equation[X] <> '.')π and (X < Length(Equation) + 1)π do beginπ Operand:= Operand + Equation[X];π Inc(X);π end;π Delete(Equation, 1, X - 1);π end;π If Length(Equation) > 0 then beginπ Temp:= '0';π X:= 1;π while (((Equation[X] <= '9') and (Equation[X] >= '0'))π or (Equation[X] = '.')) and (X < Length(Equation) + 1) doπ beginπ Temp:= Temp + Equation[X];π Inc(X);π end;π If (X > 10) and (Pos('.', Equation) > 9) then beginπ Evaluate:= Error;π Exit;π end;π Delete(Equation, 1, X - 1);π Val(Temp, Value2, Y);π If Y <> 0 then beginπ Evaluate:= Error;π Exit;π end;π end;π Temp:= '';π If Length(Operand) > 1 then beginπ Temp:= Operand;π Delete(Temp, Pos('+', Temp), 1);π If Pos('-', Temp) <> Length(Temp)π then Delete(Temp, Pos('-', Temp), 1);π Delete(Temp, Pos('x', Temp), 1);π Delete(Temp, Pos('/', Temp), 1);π Delete(Temp, Pos('^', Temp), 1);π If Pos('+', Operand) = 1 then Operand:= '+'π else if Pos('-', Operand) = 1 then Operand:= '-'π else if Pos('x', Operand) = 1 then Operand:= 'x'π else if Pos('/', Operand) = 1 then Operand:= '/'π else if Pos('^', Operand) = 1 then Operand:= '^'π else Operand:= '';π end;π OperOK:= False;π If Temp = 'SIN' then beginπ OperOK:= True;π Value2:= Sin(Rad(Value2));π end;π If Temp = 'COS' then beginπ OperOK:= True;π Value2:= Cos(Rad(Value2));π end;π If Temp = 'TAN' then if Cos(Rad(Value2)) <> 0 then beginπ OperOK:= True;π Value2:= (Sin(Rad(Value2)) / Cos(Rad(Value2)));π endπ else beginπ Evaluate:= Error;π Exit;π end;π If Temp = 'SQR' then beginπ OperOK:= True;π Value2:= Sqrt(Value2);π end;π If Temp = 'ASIN' then beginπ OperOK:= True;π Valtemp:= 1 - Sqr(Value2);π If Valtemp < 0 then beginπ Evaluate:= Error;π Exit;π endπ else If Sqrt(Valtemp) = 0 then Value2:= 90π else Value2:= Deg(ArcTan(Value2 / Sqrt(Valtemp)));π end;π If Temp = 'ACOS' then beginπ OperOK:= True;π Valtemp:= 1 - Sqr(Value2);π If Valtemp < 0 then beginπ Evaluate:= Error;π Exit;π endπ else If Value2 = 0 then Value2:= 90π else Value2:= Deg(Arctan(Sqrt(Valtemp) / Value2))π end;π 47 11-26-9317:37ALL SWAG SUPPORT GROUP Computer POWER of Number SWAG9311 8 ₧ πProcedure Power(Var Num,Togo,Sofar:LongInt);ππBeginπ If Togo = 0 thenπ Exit;π If Sofar = 0 thenπ Sofar := numπ Elseπ Sofar := Sofar*Num;π Togo := Togo-1;π Power(Num,Togo,Sofar)πEnd;ππ{π While this is programatically elegant, an iterative routine would beπ more efficient:π}ππ function power(base,exponent:longint):longint;π varπ absexp,temp,loop:longint;ππ beginπ power := 0; { error }π if exponent > 0π then exit;ππ temp := 1;π for loop := 1 to exponentπ do temp := temp * base;π power := temp;π end;ππ{πWell it all looks nice, but this is problably the easiest wayπ}ππfunction Power(base,p : real): real;ππ{ compute base^p, with base>0 }πbeginπ power := exp(p*log(base))πend;π 48 11-02-9305:38ALL THAI TRAN Expression Evaluator SWAG9311 47 ₧ {πTHAI TRANππ{πI've netmailed you the full-featured version (800 lines!) that will doπFunctions, exponentiation, factorials, and has all the bells and whistles,πbut I thought you might want to take a look at a simple version so you canπunderstand the algorithm.ππThis one only works With +, -, *, /, (, and ). I wrote it quickly, so itπmakes extensive use of global Variables and has no error checking; Use atπyour own risk.ππAlgorithm to convert infix to postfix (RPN) notationπ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~πParse through the entire expression getting each token (number, arithmeticπoperator, left or right parenthesis). For each token, if it is:π 1. an operand (number) Send it to the RPN calculatorπ 2. a left parenthesis Push it onto the operator stackπ 3. a right parenthesis Pop operators off stack and send to RPNπ calculator Until the a left parenthesis isπ on top of the stack. Pop it also, but don'tπ send it to the calculator.π 4. an operator While the stack is not empty, pop operatorsπ off the stack and send them to the RPNπ calculator Until you reach one With a higherπ precedence than the current operator (Note:π a left parenthesis has the least precendence).π Then push the current operator onto the stack.ππThis will convert (4+5)*6/(2-3) to 4 5 + 6 * 2 3 - /ππAlgorithm For RPN calculatorπ~~~~~~~~~~~~~~~~~~~~~~~~~~~~πNote: this Uses a different stack from the one described above.ππIn RPN, if an operand (a number) is entered, it is just pushed onto theπstack. For binary arithmetic operators (+, -, *, /, and ^), the top twoπoperands are popped off the stack, operated on, and the result pushed backπonto the stack. if everything has gone correctly, at the end, the answerπshould be at the top of the stack.πππReleased to Public Domain by Thai Tran (if that matters).π}ππ{$X+}πProgram Expression_Evaluator;ππConstπ RPNMax = 10; { I think you only need 4, but just to be safe }π OpMax = 25;ππTypeπ String15 = String[15];ππVarπ Expression : String;π RPNStack : Array[1..RPNMax] of Real; { Stack For RPN calculator }π RPNTop : Integer;π OpStack : Array[1..OpMax] of Char; { Operator stack For conversion }π OpTop : Integer;ππProcedure RPNPush(Num : Real); { Add an operand to the top of the RPN stack }πbeginπ if RPNTop < RPNMax thenπ beginπ Inc(RPNTop);π RPNStack[RPNTop] := Num;π endπ else { Put some error handler here }πend;ππFunction RPNPop : Real; { Get the operand at the top of the RPN stack }πbeginπ if RPNTop > 0 thenπ beginπ RPNPop := RPNStack[RPNTop];π Dec(RPNTop);π endπ else { Put some error handler here }πend;ππProcedure RPNCalc(Token : String15); { RPN Calculator }πVarπ Temp : Real;π Error : Integer;πbeginπ Write(Token, ' '); { This just outputs the RPN expression }ππ if (Length(Token) = 1) and (Token[1] in ['+', '-', '*', '/']) thenπ Case Token[1] of { Handle operators }π '+' : RPNPush(RPNPop + RPNPop);π '-' : RPNPush(-(RPNPop - RPNPop));π '*' : RPNPush(RPNPop * RPNPop);π '/' :π beginπ Temp := RPNPop;π if Temp <> 0 thenπ RPNPush(RPNPop/Temp)π else { Handle divide by 0 error }π end;π endπ elseπ begin { Convert String to number and add to stack }π Val(Token, Temp, Error);π if Error = 0 thenπ RPNPush(Temp)π else { Handle error }π end;πend;ππProcedure OpPush(Operator : Char); { Add an operator onto top of the stack }πbeginπ if OpTop < OpMax thenπ beginπ Inc(OpTop);π OpStack[OpTop] := Operator;π endπ else { Put some error handler here }πend;ππFunction OpPop : Char; { Get operator at the top of the stack }πbeginπ if OpTop > 0 thenπ beginπ OpPop := OpStack[OpTop];π Dec(OpTop);π endπ else { Put some error handler here }πend;ππFunction Priority(Operator : Char) : Integer; { Return priority of operator }πbeginπ Case Operator OFπ '(' : Priority := 0;π '+', '-' : Priority := 1;π '*', '/' : Priority := 2;π else { More error handling }π end;πend;ππProcedure Evaluate(Expr : String); { Guess }πVarπ I : Integer;π Token : String15;πbeginπ OpTop := 0; { Reset stacks }π RPNTop := 0;π Token := '';ππ For I := 1 to Length(Expr) DOπ if Expr[I] in ['0'..'9'] thenπ begin { Build multi-digit numbers }π Token := Token + Expr[I];π if I = Length(Expr) then { Send last one to calculator }π RPNCalc(Token);π endπ elseπ if Expr[I] in ['+', '-', '*', '/', '(', ')'] thenπ beginπ if Token <> '' thenπ begin { Send last built number to calc. }π RPNCalc(Token);π Token := '';π end;ππ Case Expr[I] OFπ '(' : OpPush('(');π ')' :π beginπ While OpStack[OpTop] <> '(' DOπ RPNCalc(OpPop);π OpPop; { Pop off and ignore the '(' }π end;ππ '+', '-', '*', '/' :π beginπ While (OpTop > 0) ANDπ (Priority(Expr[I]) <= Priority(OpStack[OpTop])) DOπ RPNCalc(OpPop);π OpPush(Expr[I]);π end;π end; { Case }π endπ else;π { Handle bad input error }ππ While OpTop > 0 do { Pop off the remaining operators }π RPNCalc(OpPop);πend;ππbeginπ Write('Enter expression: ');π Readln(Expression);ππ Write('RPN Expression = ');π Evaluate(Expression);π Writeln;π Writeln('Answer = ', RPNPop : 0 : 4);πend.π 49 11-02-9305:14ALL TIM MCKAY Conversion to Base 36 SWAG9311 14 ₧ (*πFrom: TIM MCKAYπSubj: RE: COVERTING TO BASE 36ππ JF> Can someone please show me how I would convert a base 10 number toπ JF> base 36? (The one used by RIP)π*)ππprogram convertbase;ππ const B: integer = 36; { B = the base to convert to }π S: string = ''; { S = the string representation of theπ result }π done: boolean = false;ππ var X, I, F: integer; { X = the original base 10 numberπ I = the integer portion of the resultπ F = the fractional portion of theπ result }π R: real; { R = theπintermediate real result }ππ beginπ readln(X); { Get original base 10 number }π R:=X;π while (not done) do begin { This loop continues to divide the }π R:= R/B; { result by the base until it reaches 0 }π I:= int (R); { The integer portion of the result is }π R:= I; { reassigned to R }π F:= frac(R) * B; { The fractional portion is converted to}π if f<10 then begin { an integer remainder of the original }π S:=chr(f+$30) + S; { base and converted to a character to }π end else begin { be added to the string representation }π S:=chr(f+$37) + S;π end;π if R<=0 then done:=true; { When R reaches 0 then you're done }π end;π writeln(S);π end.ππ 50 11-21-9309:29ALL WARREN PORTER Math Evaluations SWAG9311 72 ₧ {πFrom: WARREN PORTERπSubj: evalπProgram to evaluate expressions using a stack. }ππconstπ Maxstack = 100;ππtypeππ stack = recordπ top : 0..Maxstack;π Item : array[1..Maxstack] of charπ end;ππ RealStack = recordπ top: 0..Maxstack;π Item : array[1..Maxstack] of realπ end;ππ xptype = recordπ oper : char;π opnd : realπ end;ππFunction Empty(var A:stack):boolean;ππBeginπ Empty:= A.top = 0;πEnd;ππFunction Pop(var A:stack):char;ππBeginπ if A.Top < 1 thenπ beginπ writeln('Attempt to pop an empty stack');π halt(1)π end;π Pop:= A.item[A.top];π A.top:= A.top - 1πEnd;ππProcedure Push(var A:stack; Nchar:char);ππBeginπ if A.Top = Maxstack thenπ beginπ writeln('Stack already full');π halt(1)π end;π A.top:= A.top + 1;π A.item[A.top]:=NcharπEnd;ππ {The following functions are for the real stack only.}ππFunction REmpty(var D:RealStack):boolean;ππBeginπ REmpty:= D.top = 0;πEnd;ππFunction RPop(var D:RealStack):real;ππBeginπ if D.Top < 1 thenπ beginπ writeln('Attempt to pop an empty RealStack');π halt(1)π end;π RPop:= D.item[D.top];π D.top:= D.top - 1πEnd;ππProcedure RPush(var D:RealStack; Nreal:real);ππBeginπ if D.Top = MaxStack thenπ beginπ writeln('Stack already full');π halt(1)π end;π D.top:= D.top + 1;π D.item[D.top]:=NrealπEnd;ππFunction pri(op1, op2:char):boolean;ππvarπ tpri: boolean;πBeginπ if op2 = ')' thenπ tpri:= true elseπ if (op1 = '$') and (op2 <> '$') and (op2 <> '(') thenπ tpri:= true elseπ if (op1 in ['*','/']) and (op2 in ['+','-']) thenπ tpri:= trueπ elseπ tpri:= false;π pri:= tpri{;π write('Eval op 1= ',op1, ' op2 = ',op2);π if tpri= false thenπ writeln(' false')π elseπ writeln(' true')}πEnd;ππFunction ConvReal(a:real;NumDec:integer):real;ππvarπ i, tenpower: integer;ππBeginπ tenpower:= 1;π for i:= 1 to NumDec doπ tenpower:= tenpower * 10;π ConvReal:= a / tenpowerπEnd;ππFunction ROper(opnd1, opnd2: real; oper: char):real;πVar temp: real;ππBeginπ Case oper ofπ '+': temp:= opnd1 + opnd2;π '-': temp:= opnd1 - opnd2;π '*': temp:= opnd1 * opnd2;π '/': temp:= opnd1 / opnd2;π '$': temp:= exp(ln(opnd1) * opnd2)π End {Case} ;π {Writeln(opnd1:6:3,' ',oper,' ',opnd2:6:3 ,' = ',temp:6:3);}π ROper := tempπEnd; {R oper}ππ{Main procedure starts here}ππvarπ A: stack;π Inbuff:string[Maxstack];π len, i, j, NumDecPnt, lenexp: integer;π temp, opnd1, opnd2, result : real;π valid, expdigit, expdec, isneg, openok: boolean;π operators, digits : set of char;π HoldTop : char;π B: array[1..Maxstack] of xptype;π C: array[1..Maxstack] of xptype;π D: RealStack;ππBeginπ digits:= ['0'..'9'];π operators:= ['$','*','/','+','-','(',')'];π Writeln('Enter expression to evaluate or RETURN to stop');π Writeln('A space should follow a minus sign unless it is used to');π Writeln('negate the following number. Real numbers with multi-');π Writeln('digits and decimal point (if needed) may be entered.');π Writeln;π Readln(Inbuff);π len:=length(Inbuff);ππ repeatπ i:= 1;π A.top:= 0;π valid:= true;π repeatπ if Inbuff[i] in ['(','[','{'] thenπ push(A,Inbuff[i])π elseπ if Inbuff[i] in [')',']','}'] thenπ if empty(A) thenπ valid:= falseπ elseπ if (ord(Inbuff[i]) - ord(Pop(A))) > 2 thenπ valid:= false;π i:= i + 1π until (i > len) or (not valid);π if not empty(A) thenπ valid:= false;π if not valid thenπ Writeln('The expression is invalid')π elseπ Beginπ {Change all groupings to parenthesis}π for i:= 1 to len do Beginπ if Inbuff[i] in ['[','{'] thenπ Inbuff[i]:= '(' elseπ if Inbuff[i] in [']','}'] thenπ Inbuff[i]:= ')';π B[i].oper:= ' ';π B[i].opnd:= 0;π C[i].oper:= ' ';π C[i].opnd:= 0 End;ππ { The B array will be the reformatted input string.π The C array will be the postfix expression. }ππ i:= 1; j:= 1; expdigit:= false; expdec:= false; isneg:= false;π while i <= len doπ Beginπ if (Inbuff[i] = '-') and (Inbuff[i + 1] in digits) thenπ Beginπ isneg:= true;π i:= i + 1π End;π if (Inbuff[i] = '.' ) then Beginπ i:= i + 1;π expdec:= true End;π if Inbuff[i] in digits thenπ Beginπ if expdec thenπ NumDecPnt:= NumDecPnt + 1;π if expdigit thenπ temp:= temp * 10 + ord(inbuff[i]) - ord('0')π else Beginπ temp:= ord(inbuff[i]) - ord('0');π expdigit:= true Endπ Endπ elseπ if expdigit = true then Beginπ if isneg thenπ temp:= temp * -1;π B[j].opnd:= ConvReal(temp,NumDecPnt);π j:= j + 1;π expdigit := false;π expdec := false;π NumDecPnt:= 0;π isneg:= false End;ππ If Inbuff[i] in operators then Beginπ B[j].oper:= Inbuff[i];π j:= j + 1 End;ππ if not (Inbuff[i] in digits) andπ not (Inbuff[i] in operators) andπ not (Inbuff[i] = ' ') then Beginπ Writeln('Found invalid operator: ',Inbuff[i]);π valid:= false End;ππ i:= i + 1;ππ End; {While loop to parse string.}ππ if expdigit = true then Beginπ if isneg thenπ temp:= temp * -1;π B[j].opnd:= ConvReal(temp,NumDecPnt);π j:= j + 1;π expdigit := false;π expdec := false;π NumDecPnt:= 0;π isneg:= false End;ππ End; {First if valid loop. Next one won't run if invalid operator}ππ if valid thenπ Beginπ lenexp:= j - 1; {Length of converted expression}π writeln;π for i:= 1 to lenexp doπ Beginπ if B[i].oper = ' ' thenπ write(B[i].opnd:2:3)π elseπ write(B[i].oper);π write(' ')π End;ππ {Ready to create postfix expression in array C }ππ A.top:= 0;π j:= 0;ππ for i:= 1 to lenexp doπ Beginπ {writeln('i = ',i);}π if B[i].oper = ' ' then Beginπ j:= j + 1;π C[j].opnd:= B[i].opnd Endπ elseπ Beginπ openok := true;π while (not empty(A) and openok andπ pri(A.item[A.top],B[i].oper)) doπ Beginπ HoldTop:= pop(A);π if HoldTop = '(' thenπ openok:= falseπ elseπ Beginπ j:= j + 1;π C[j].oper:=HoldTopπ Endπ End;π if B[i].oper <> ')' thenπ push(A,B[i].oper);π End; {Else}π End; {For loop}ππ while not empty(A) doπ Beginπ HoldTop:= pop(A);π if HoldTop <> '(' thenπ Beginπ j:= j + 1;π C[j].oper:=HoldTopπ Endπ End;ππ lenexp:= j; {Since parenthesis are not included in postfix.}ππ for i:= 1 to lenexp doπ Beginπ if C[i].oper = ' ' thenπ write(C[i].opnd:2:3)π elseπ write(C[i].oper);π write(' ')π End;ππ {The following evaluates the expression in the real stack}ππ D.top:=0;π for i:= 1 to lenexp doπ Beginπ if C[i].oper = ' ' thenπ Rpush(D,C[i].opnd)π elseπ Beginπ opnd2:= Rpop(D);π opnd1:= Rpop(D);π result:= ROper(opnd1,opnd2,C[i].oper);π Rpush(D,result)π End {else}π End; {for loop}π result:= Rpop(D);π if Rempty(D) thenπ writeln(' = ',result:2:3)π elseπ writeln(' Could not evaluate',chr(7))π End;ππ Readln(Inbuff);π len:= length(Inbuff)π until len = 0πEnd.ππ 51 11-02-9310:30ALL WILLIAM SCHROEDER PATTERNS SWAG9311 30 ₧ {πWILLIAM SCHROEDERππI'd like to extend thanks to everyone For helping me set up a PATTERN Program.πYes, I have done it! Unfortunatley, this Program doesn't have all possibleπpattern searches, but I figured out an algorithm For increasing size geometricπpatterns such as 2 4 7 11. The formula produced is as follows: N = the Nthπterm. So whatever the formula, if you want to find an Nth term, get out someπpaper and replace N! :) Well, here's the Program, folks. I hope somebody canπmake some improvements on it...π}πProgram PatternFinder;ππUsesπ Crt;ππVarπ ans : Char;π PatType : Byte;π n1, n2,π n3, n4 : Integer;ππProcedure GetInput;πbeginπ ClrScr;π TextColor(lightcyan);π Writeln('This Program finds patterns For numbers in increasing size.');π Write('Enter the first four terms in order: ');π TextColor(yellow);π readln(n1, n2, n3, n4);πend;ππProcedure TestRelations;πbeginπ PatType := 0;π { 1 3 5 }π if (n3 - n2 = n2 - n1) and ((n4 - n3) = n2 - n1) thenπ PatType := 1π elseπ { 1 3 9 }π if (n3 / n2) = (n4 / n3) thenπ PatType := 2π elseπ { 1 1 2 }π if (n3 = n2 + n1) and (n4 = (n3 + n2)) thenπ PatType := 3π elseπ { 1 2 4 7 11 }π if ((n4 - n3) - (n3 - n2)) = ((n3 - n2) - (n2 - n1)) thenπ PatType := 4;πend;ππProcedure FindFormula;ππ Procedure DoGeoCalc;π Varπ Factor : Real;π Dif,π Shift,π tempn,π nx, ny : Integer;π beginπ Dif := (n3 - n2) - (n2 - n1);π Factor := Dif * 0.5;π Shift := 0;π ny := n2;π nx := n1;π if ny > nx thenπ While (ny-nx) <> dif doπ beginπ Inc(Shift);π tempn := nx;π nx := nx - ((ny - nx) - dif);π ny := tempn;π end;π if Factor <> 1 thenπ Write('(', Factor : 0 : 1, ')');π if Shift = 0 thenπ Write('(N + 0)(N - 1)')π elseπ beginπ if Shift > 0 thenπ beginπ Write('(N + ', shift, ')(N');π if Shift = 1 thenπ Write(')')π elseπ Write(' + ', shift - 1, ')');π end;π end;π if nx <> 0 thenπ Writeln(' + ', nx)π elseπ Writeln;π end;ππbeginπ TextColor(LightGreen);π Writeln('Formula =');π TextColor(white);π Case PatType ofπ 1 :π beginπ { Nth term = first term + difference * (N - 1) }π if n2 - n1 = 0 thenπ Writeln(n1)π elseπ if (n2 - n1 = 1) and (n1 - 1 = 0) thenπ Writeln('N')π elseπ if n2 - n1 = 1 thenπ Writeln('N + ', n1 - 1)π elseπ if (n2 - n1) = n1 thenπ Writeln(n1, 'N')π elseπ Writeln(n2 - n1, '(N - 1) + ', n1);π end;ππ 2 :π beginπ { Nth term = first term * ratio^(N - 1) }π if n1 = 1 thenπ Writeln(n2 / n1 : 0 : 0, '^(N - 1)')π elseπ Writeln(n1, ' x ', n2 / n1 : 0 : 0, '^(N - 1)');π end;ππ 3 :π beginπ { Fibonacci Sequence }π Writeln('No formula: Fibonacci Sequence (Term1 + Term2 = Term3)');π Writeln(' ',π n1 : 5, ' + ', n2 : 5, ' = ', (n1 + n2) : 5);π end;ππ 4 :π beginπ { Geometric Patterns }π DoGeoCalc;π end;π end;πend;ππbeginπ GetInput;π TestRelations;π TextColor(LightRed);π Writeln;π if PatType <> 0 thenπ FindFormulaπ elseπ Writeln('No pattern found: This Program may not know how to look '+π 'for that pattern.');π TextColor(lightred);π Writeln;π Write('Press any key...');π ans := ReadKey;π ClrScr;πend.ππ{πThat's all folks! if you can find and fix any bugs For me, please send me thatπsection of the code so I can change it. if anybody cares to ADD to the patternπcheck, be my guest! This Program can be altered and used by ANYBODY. I'd justπlike to expand it a bit. Have fun!π}π
